[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/08: installer: New page to edit user accounts.
From: |
John Darrington |
Subject: |
04/08: installer: New page to edit user accounts. |
Date: |
Fri, 10 Feb 2017 08:17:11 -0500 (EST) |
jmd pushed a commit to branch wip-installer
in repository guix.
commit 0e2888d7489b4ad7a5fc6bca439a55c57f031c0d
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 b732958..26bd6e3 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -456,6 +456,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)
- branch wip-installer updated (688f4f7 -> e0eeeab), John Darrington, 2017/02/10
- 08/08: gurses: Don't crash if asked for an item by an invalid index., John Darrington, 2017/02/10
- 06/08: installer: Remove whitespace., John Darrington, 2017/02/10
- 05/08: gurses: Update the cursor position when posting the form., John Darrington, 2017/02/10
- 03/08: installer: Remove unused procedure., John Darrington, 2017/02/10
- 01/08: installer: Fix the startup locale., John Darrington, 2017/02/10
- 07/08: installer: Provide the ability to add new users., John Darrington, 2017/02/10
- 04/08: installer: New page to edit user accounts.,
John Darrington <=
- 02/08: installer: Add users page., John Darrington, 2017/02/10