jmd pushed a commit to branch wip-installer in repository guix. commit d70e6a1f6bf8ddb2cecd15427a0e46d2efdbfbd1 Author: John Darrington <j...@gnu.org> Date: Sat Jan 7 08:15:48 2017 +0100
installer: Ensure that the cursor visibility is updated on each page. * gnu/system/installer/page.scm (make-page) : Add new parameter: cursor-visibility. * gnu/system/installer/configure.scm, gnu/system/installer/dialog.scm, gnu/system/installer/disks.scm, gnu/system/installer/file-browser.scm, gnu/system/installer/filesystems.scm, gnu/system/installer/guixsd-installer.scm, gnu/system/installer/hostname.scm, gnu/system/installer/install.scm, gnu/system/installer/network.scm, gnu/system/installer/passphrase.scm, gnu/system/installer/role.scm, gnu/system/installer/time-zone.scm, gnu/system/installer/wireless.scm: Deal with the consequences. --- gnu/system/installer/configure.scm | 2 ++ gnu/system/installer/dialog.scm | 4 +++- gnu/system/installer/disks.scm | 6 ++++-- gnu/system/installer/file-browser.scm | 4 +++- gnu/system/installer/filesystems.scm | 4 +++- gnu/system/installer/guixsd-installer.scm | 3 ++- gnu/system/installer/hostname.scm | 2 ++ gnu/system/installer/install.scm | 4 +++- gnu/system/installer/mount-point.scm | 3 ++- gnu/system/installer/network.scm | 3 +++ gnu/system/installer/page.scm | 12 ++++++++---- gnu/system/installer/passphrase.scm | 2 ++ gnu/system/installer/role.scm | 2 ++ gnu/system/installer/time-zone.scm | 4 ++++ gnu/system/installer/wireless.scm | 2 ++ 15 files changed, 45 insertions(+), 12 deletions(-) diff --git a/gnu/system/installer/configure.scm b/gnu/system/installer/configure.scm index e0594b6..c2a86ee 100644 --- a/gnu/system/installer/configure.scm +++ b/gnu/system/installer/configure.scm @@ -41,6 +41,7 @@ (let ((page (make-page (page-surface parent) title configure-page-refresh + 0 configure-page-key-handler))) page)) @@ -224,6 +225,7 @@ (generate-guix-config p (getmaxx (inner config-window))) (force-output p)) + (push-cursor (page-cursor-visibility p)) (page-set-wwin! p pr) (page-set-datum! p 'navigation buttons) (buttons-post buttons bwin) diff --git a/gnu/system/installer/dialog.scm b/gnu/system/installer/dialog.scm index 785c02c..e6976a1 100644 --- a/gnu/system/installer/dialog.scm +++ b/gnu/system/installer/dialog.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 John Darrington <j...@gnu.org> +;;; Copyright © 2016, 2017 John Darrington <j...@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,6 +31,7 @@ (let ((page (make-page (page-surface parent) (gettext "Information") dialog-page-refresh + 0 dialog-page-key-handler))) (page-set-datum! page 'message message) (page-set-datum! page 'justify justify) @@ -89,6 +90,7 @@ (addstr text-window (if (promise? m) (force m) m)))) + (push-cursor (page-cursor-visibility p)) (page-set-wwin! p frame) (page-set-datum! p 'text-window text-window) (page-set-datum! p 'navigation buttons) diff --git a/gnu/system/installer/disks.scm b/gnu/system/installer/disks.scm index b53dc0a..ac1007f 100644 --- a/gnu/system/installer/disks.scm +++ b/gnu/system/installer/disks.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 John Darrington <j...@gnu.org> +;;; Copyright © 2016, 2017 John Darrington <j...@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -34,6 +34,7 @@ (make-page (page-surface parent) title disk-page-refresh + 0 disk-page-key-handler)) (define (disk-page-refresh page) @@ -140,7 +141,8 @@ (list (truncate-string (disk-vendor d) w)) (number->size (disk-size d)) (length (disk-partitions d)))))))) - + + (push-cursor (page-cursor-visibility p)) (page-set-datum! p 'text-window text-window) (page-set-wwin! p frame) (page-set-datum! p 'menu menu) diff --git a/gnu/system/installer/file-browser.scm b/gnu/system/installer/file-browser.scm index f07b97c..4e7f4f2 100644 --- a/gnu/system/installer/file-browser.scm +++ b/gnu/system/installer/file-browser.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 John Darrington <j...@gnu.org> +;;; Copyright © 2016, 2017 John Darrington <j...@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -30,6 +30,7 @@ (let ((page (make-page (page-surface parent) (gettext "File Browser") file-browser-page-refresh + 0 file-browser-page-key-handler))) (page-set-datum! page 'directory directory) (if exit-point @@ -116,6 +117,7 @@ (addstr* text-window (gettext "Select an item most closely matching your keyboard layout:" )) + (push-cursor (page-cursor-visibility p)) (page-set-wwin! p frame) (page-set-datum! p 'menu menu) (page-set-datum! p 'navigation buttons) diff --git a/gnu/system/installer/filesystems.scm b/gnu/system/installer/filesystems.scm index 011c6f3..6dfa3cb 100644 --- a/gnu/system/installer/filesystems.scm +++ b/gnu/system/installer/filesystems.scm @@ -101,6 +101,7 @@ (make-page (page-surface parent) title filesystem-page-refresh + 0 filesystem-page-key-handler)) @@ -180,6 +181,7 @@ (format #f (gettext "Choose the mount point for device ~s") name) mount-point-refresh + 1 mount-point-page-key-handler))) (page-set-datum! next 'device name) @@ -236,7 +238,7 @@ (let ((x (assoc-ref mount-points name))) (if x x "")))))))) - + (push-cursor (page-cursor-visibility p)) (page-set-wwin! p pr) (page-set-datum! p 'menu menu) (page-set-datum! p 'navigation buttons) diff --git a/gnu/system/installer/guixsd-installer.scm b/gnu/system/installer/guixsd-installer.scm index b73839d..20dbb04 100644 --- a/gnu/system/installer/guixsd-installer.scm +++ b/gnu/system/installer/guixsd-installer.scm @@ -211,6 +211,7 @@ (page-set-datum! page 'menu main-menu) (menu-post main-menu win)) + (push-cursor (page-cursor-visibility page)) ;; Do the key action labels (let ((ypos (1- (getmaxy background))) (str0 (gettext "Get a Shell <F1>")) @@ -260,7 +261,7 @@ (let ((page (make-page stdscr (gettext "GuixSD Installer") - main-page-refresh main-page-key-handler))) + main-page-refresh 0 main-page-key-handler))) (page-enter page) (let loop ((ch (getch stdscr))) diff --git a/gnu/system/installer/hostname.scm b/gnu/system/installer/hostname.scm index 66096cb..1c561c4 100644 --- a/gnu/system/installer/hostname.scm +++ b/gnu/system/installer/hostname.scm @@ -44,6 +44,7 @@ (make-page (page-surface parent) title host-name-refresh + 1 host-name-key-handler)) (define (host-name-refresh page) @@ -139,6 +140,7 @@ (page-set-datum! p 'navigation nav) (page-set-datum! p 'text-window text-window) (page-set-datum! p 'form form) + (push-cursor (page-cursor-visibility p)) (form-post form fw) (buttons-post nav bwin) diff --git a/gnu/system/installer/install.scm b/gnu/system/installer/install.scm index 3ba1327..53d32a4 100644 --- a/gnu/system/installer/install.scm +++ b/gnu/system/installer/install.scm @@ -37,6 +37,7 @@ (let ((page (make-page (page-surface parent) title install-page-refresh + 0 install-page-key-handler))) page)) @@ -158,7 +159,8 @@ (addstr* text-window (gettext "Choose \"Continue\" to start installing the system.")) - + + (push-cursor (page-cursor-visibility p)) (page-set-wwin! p pr) (page-set-datum! p 'navigation buttons) (page-set-datum! p 'config-window (inner config-window)) diff --git a/gnu/system/installer/mount-point.scm b/gnu/system/installer/mount-point.scm index 2468ba2..5b922fe 100644 --- a/gnu/system/installer/mount-point.scm +++ b/gnu/system/installer/mount-point.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 John Darrington <j...@gnu.org> +;;; Copyright © 2016, 2017 John Darrington <j...@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -173,6 +173,7 @@ (or (assoc-ref mount-points dev) ""))) + (push-cursor (page-cursor-visibility p)) (buttons-post nav bwin) (page-set-datum! p 'form form) diff --git a/gnu/system/installer/network.scm b/gnu/system/installer/network.scm index 4607a1d..bbf60d9 100644 --- a/gnu/system/installer/network.scm +++ b/gnu/system/installer/network.scm @@ -35,6 +35,7 @@ (make-page (page-surface parent) title network-page-refresh + 0 network-page-key-handler)) (define (interfaces) @@ -105,6 +106,7 @@ (let ((next (make-page (page-surface page) "Ping" ping-page-refresh + 0 ping-page-key-handler))) (page-enter next))) @@ -203,6 +205,7 @@ (sigaction SIGALRM (lambda (_) (menu-redraw menu))) (setitimer ITIMER_REAL 1 0 1 0) + (push-cursor (page-cursor-visibility p)) (page-set-wwin! p pr) (page-set-datum! p 'menu menu) (page-set-datum! p 'navigation buttons) diff --git a/gnu/system/installer/page.scm b/gnu/system/installer/page.scm index aaae044..1197371 100644 --- a/gnu/system/installer/page.scm +++ b/gnu/system/installer/page.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 John Darrington <j...@gnu.org> +;;; Copyright © 2016, 2017 John Darrington <j...@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,28 +27,31 @@ #:export (page-leave) #:export (page-set-wwin!) #:export (page-wwin) + #:export (page-cursor-visibility) #:export (page-title) #:export (page-datum) #:export (page-set-datum!) #:export (page-key-handler) + #:use-module (gnu system installer utils) #:use-module (srfi srfi-9)) (define page-stack '()) (define-record-type <page> - (make-page' surface title inited refresh key-handler data) + (make-page' surface title inited refresh cursor-visibility key-handler data) page? (title page-title) (surface page-surface) (inited page-initialised? page-set-initialised!) (refresh page-refresh) + (cursor-visibility page-cursor-visibility) (key-handler page-key-handler) (wwin page-wwin page-set-wwin!) (data page-data page-set-data!)) -(define (make-page surface title refresh key-handler) - (make-page' surface title #f refresh key-handler '())) +(define (make-page surface title refresh cursor-visibility key-handler) + (make-page' surface title #f refresh cursor-visibility key-handler '())) (define (page-set-datum! page key value) (page-set-data! page (acons key value (page-data page)))) @@ -57,6 +60,7 @@ (assq-ref (page-data page) key)) (define* (page-leave #:optional (return-point #f)) + (pop-cursor) (set! page-stack (or return-point (cdr page-stack)))) diff --git a/gnu/system/installer/passphrase.scm b/gnu/system/installer/passphrase.scm index 42b7b0c..167719e 100644 --- a/gnu/system/installer/passphrase.scm +++ b/gnu/system/installer/passphrase.scm @@ -37,6 +37,7 @@ (make-page (page-surface parent) title passphrase-refresh + 1 passphrase-key-handler))) (page-set-datum! page 'network network) (page-set-datum! page 'ifce ifce) @@ -119,6 +120,7 @@ (form (make-form my-fields))) + (push-cursor (page-cursor-visibility p)) (page-set-datum! p 'navigation nav) (page-set-datum! p 'text-window text-window) (page-set-datum! p 'form form) diff --git a/gnu/system/installer/role.scm b/gnu/system/installer/role.scm index 9d4baf4..6391642 100644 --- a/gnu/system/installer/role.scm +++ b/gnu/system/installer/role.scm @@ -49,6 +49,7 @@ (make-page (page-surface parent) title role-page-refresh + 0 role-page-key-handler)) @@ -158,6 +159,7 @@ (gettext "Select from the list below the role which most closely matches the purpose of the system to be installed."))) + (push-cursor (page-cursor-visibility p)) (page-set-wwin! p pr) (page-set-datum! p 'menu menu) diff --git a/gnu/system/installer/time-zone.scm b/gnu/system/installer/time-zone.scm index 8b676ff..59ff2d6 100644 --- a/gnu/system/installer/time-zone.scm +++ b/gnu/system/installer/time-zone.scm @@ -30,6 +30,7 @@ (let ((page (make-page (page-surface parent) (gettext "Time Zone") time-zone-page-refresh + 0 time-zone-page-key-handler))) (page-set-datum! page 'directory directory) (if exit-point @@ -135,6 +136,9 @@ (addstr* text-window (gettext "Select the default time zone for the system:" )) + + (push-cursor (page-cursor-visibility p)) + (page-set-wwin! p frame) (page-set-datum! p 'menu menu) (page-set-datum! p 'navigation buttons) diff --git a/gnu/system/installer/wireless.scm b/gnu/system/installer/wireless.scm index c1e42a0..271a6ff 100644 --- a/gnu/system/installer/wireless.scm +++ b/gnu/system/installer/wireless.scm @@ -38,6 +38,7 @@ (let ((page (make-page (page-surface parent) title wireless-page-refresh + 0 wireless-page-key-handler))) (page-set-datum! page 'ifce interface) @@ -138,6 +139,7 @@ (gettext "Select an access point to connect."))) + (push-cursor (page-cursor-visibility p)) (page-set-wwin! p pr) (page-set-datum! p 'menu menu) (page-set-datum! p 'navigation buttons)