[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
06/20: installer: Ensure that the cursor visibility is updated on each p
|
From: |
John Darrington |
|
Subject: |
06/20: installer: Ensure that the cursor visibility is updated on each page. |
|
Date: |
Thu, 12 Jan 2017 20:41:03 +0000 (UTC) |
jmd pushed a commit to branch wip-installer
in repository guix.
commit d70e6a1f6bf8ddb2cecd15427a0e46d2efdbfbd1
Author: John Darrington <address@hidden>
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 <address@hidden>
+;;; Copyright © 2016, 2017 John Darrington <address@hidden>
;;;
;;; 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 <address@hidden>
+;;; Copyright © 2016, 2017 John Darrington <address@hidden>
;;;
;;; 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 <address@hidden>
+;;; Copyright © 2016, 2017 John Darrington <address@hidden>
;;;
;;; 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 <address@hidden>
+;;; Copyright © 2016, 2017 John Darrington <address@hidden>
;;;
;;; 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 <address@hidden>
+;;; Copyright © 2016, 2017 John Darrington <address@hidden>
;;;
;;; 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)
- 05/20: installer: New procedure: page-enter., (continued)
- 05/20: installer: New procedure: page-enter., John Darrington, 2017/01/12
- 11/20: installer: Add installer source files to the manifest of translatables., John Darrington, 2017/01/12
- 15/20: installer: slurp: Ignore blank lines in output., John Darrington, 2017/01/12
- 04/20: installer: New procedure "page-leave"., John Darrington, 2017/01/12
- 18/20: guix: Add IFF_RUNNING to exported syscall constants., John Darrington, 2017/01/12
- 20/20: installer: Enable direct scrolling to top or bottom of menus., John Darrington, 2017/01/12
- 19/20: installer: Make the network menu more reliable., John Darrington, 2017/01/12
- 07/20: installer: Rename "Back" buttons to "Cancel"., John Darrington, 2017/01/12
- 13/20: installer: Use guix build syscalls module for network interrogation., John Darrington, 2017/01/12
- 10/20: installer: Rename 'file-browser.scm' to 'key-map.scm'., John Darrington, 2017/01/12
- 06/20: installer: Ensure that the cursor visibility is updated on each page.,
John Darrington <=
- 16/20: installer: Minor cleanup., John Darrington, 2017/01/12