guix-commits
[Top][All Lists]
Advanced

[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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]