188/197: installer: Go back to main menu after "cancel"

[Danny Milosavljevic]

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

commit 61060c4a0abe7d5c1d55831d76f2c03831aa40ad
Author: John Darrington <address@hidden>
Date:   Mon Feb 20 17:11:05 2017 +0100

    installer: Go back to main menu after "cancel"
    
    * gnu/system/installer/guixsd-installer.scm: (guixsd-installer): Perform
    a "major" pop when a cancelled page is encountered.
    * gnu/system/installer/levelled-stack.scm (page-pop, page-ppop):
    Do not remove the first #f in the stack.
    * gnu/system/installer/configure.scm,
    gnu/system/installer/filesystems.scm,
    gnu/system/installer/format.scm,
    gnu/system/installer/hostname.scm,
    gnu/system/installer/role.scm,
    gnu/system/installer/time-zone.scm: Return the symbol 'cancelled when a 
page's
    cancel button is activated.
---
 gnu/system/installer/configure.scm        |   9 +--
 gnu/system/installer/filesystems.scm      | 113 +++++++++++++++---------------
 gnu/system/installer/format.scm           |   8 +--
 gnu/system/installer/guixsd-installer.scm |   6 +-
 gnu/system/installer/hostname.scm         |   6 +-
 gnu/system/installer/levelled-stack.scm   |  11 +--
 gnu/system/installer/role.scm             |  15 ++--
 gnu/system/installer/time-zone.scm        |  14 ++--
 8 files changed, 85 insertions(+), 97 deletions(-)

diff --git a/gnu/system/installer/configure.scm 
b/gnu/system/installer/configure.scm
index f176edf..90ad45a 100644
--- a/gnu/system/installer/configure.scm
+++ b/gnu/system/installer/configure.scm
@@ -101,9 +101,8 @@
 
      ((buttons-key-matches-symbol? nav ch 'cancel)
       ;; Close the menu and return
-      (page-leave))
-
-
+      (page-leave)
+      'cancelled)
 
      ((buttons-key-matches-symbol? nav ch 'save)
 
@@ -116,9 +115,7 @@
 
       ;; Close the menu and return
       (page-leave))
-     )
-
-    #f))
+     )))
 
 (define (configure-page-refresh page)
   (when (not (page-initialised? page))
diff --git a/gnu/system/installer/filesystems.scm 
b/gnu/system/installer/filesystems.scm
index 2ec7d3e..02573e2 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -174,64 +174,61 @@
 
 
 (define (filesystem-page-key-handler page ch)
-  (let ((menu (page-datum page 'menu))
-       (nav  (page-datum page 'navigation)))
-
-    (cond
-     ((eq? ch KEY_RIGHT)
-      (menu-set-active! menu #f)
-      (buttons-select-next nav))
-
-     ((eq? ch #\tab)
-      (cond
-       ((menu-active menu)
-        (menu-set-active! menu #f)
-        (buttons-select nav 0))
-
-       ((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
-       (menu-set-active! menu #t)
-       (buttons-unselect-all nav))
-
-       (else
-       (buttons-select-next nav))))
-
-     ((eq? ch KEY_LEFT)
-      (menu-set-active! menu #f)
-      (buttons-select-prev nav))
-
-     ((eq? ch KEY_UP)
-      (buttons-unselect-all nav)
-      (menu-set-active! menu #t))
-
-     ((eq? ch #\newline)
-      (let* ((dev (list-ref (menu-items menu) (menu-current-item menu)))
-            (name (partition-name (car dev)))
-            (next  (make-page (page-surface page)
-                              (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)
-        (page-enter next)))
-
-     ((buttons-key-matches-symbol? nav ch 'cancel)
-      (page-leave))
-
-
-     ((buttons-key-matches-symbol? nav ch 'continue)
-      (let ((errstr (filesystem-task-incomplete-reason)))
-        (if errstr
-            (let ((next (make-dialog page errstr)))
-              (page-enter next))
-            (begin
-              (page-leave))
-            ))))
-
-    (std-menu-key-handler menu ch))
-  #f
-  )
+  (let* ((menu (page-datum page 'menu))
+         (nav  (page-datum page 'navigation))
+         (result   (cond
+                ((eq? ch KEY_RIGHT)
+                 (menu-set-active! menu #f)
+                 (buttons-select-next nav))
+
+                ((eq? ch #\tab)
+                 (cond
+                  ((menu-active menu)
+                   (menu-set-active! menu #f)
+                   (buttons-select nav 0))
+
+                  ((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
+                   (menu-set-active! menu #t)
+                   (buttons-unselect-all nav))
+
+                  (else
+                   (buttons-select-next nav))))
+
+                ((eq? ch KEY_LEFT)
+                 (menu-set-active! menu #f)
+                 (buttons-select-prev nav))
+
+                ((eq? ch KEY_UP)
+                 (buttons-unselect-all nav)
+                 (menu-set-active! menu #t))
+
+                ((eq? ch #\newline)
+                 (let* ((dev (list-ref (menu-items menu) (menu-current-item 
menu)))
+                        (name (partition-name (car dev)))
+                        (next  (make-page (page-surface page)
+                                          (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)
+                   (page-enter next)))
+
+                ((buttons-key-matches-symbol? nav ch 'cancel)
+                 (page-leave)
+                 'cancelled)
+
+                ((buttons-key-matches-symbol? nav ch 'continue)
+                 (let ((errstr (filesystem-task-incomplete-reason)))
+                   (if errstr
+                       (let ((next (make-dialog page errstr)))
+                         (page-enter next))
+                       (page-leave)
+                       ))))))
+
+    (std-menu-key-handler menu ch)
+    result))
 
 (define (filesystem-page-init p)
   (let* ((s (page-surface p))
diff --git a/gnu/system/installer/format.scm b/gnu/system/installer/format.scm
index b8c5f5e..99e1d02 100644
--- a/gnu/system/installer/format.scm
+++ b/gnu/system/installer/format.scm
@@ -74,7 +74,6 @@ match those uuids read from the respective partitions"
 
 
 (define (format-page-key-handler page ch)
-
   (let ((nav  (page-datum page 'navigation))
        (config-window  (page-datum page 'config-window)))
 
@@ -99,7 +98,8 @@ match those uuids read from the respective partitions"
 
      ((buttons-key-matches-symbol? nav ch 'cancel)
       ;; Close the menu and return
-      (page-leave))
+      (page-leave)
+      'cancelled)
 
 
      ((buttons-key-matches-symbol? nav ch 'format)
@@ -143,9 +143,7 @@ match those uuids read from the respective partitions"
 
       (when (filesystems-are-current?)
             (page-leave))
-      ))
-
-    #f))
+      ))))
 
 (define (format-page-refresh page)
   (when (not (page-initialised? page))
diff --git a/gnu/system/installer/guixsd-installer.scm 
b/gnu/system/installer/guixsd-installer.scm
index 6529d1a..7bfb060 100644
--- a/gnu/system/installer/guixsd-installer.scm
+++ b/gnu/system/installer/guixsd-installer.scm
@@ -316,8 +316,10 @@
         (page-enter page)
         (page-push #f)
         (let loop ((ch (getch stdscr)))
-          (let ((current-page (page-top)))
-            ((page-key-handler current-page) current-page ch)
+          (let* ((current-page (page-top))
+                 (ret ((page-key-handler current-page) current-page ch)))
+            (when (eq? ret 'cancelled)
+                  (page-ppop))
             (base-page-key-handler current-page ch))
           ((page-refresh (page-top)) (page-top))
           (loop (getch stdscr)))
diff --git a/gnu/system/installer/hostname.scm 
b/gnu/system/installer/hostname.scm
index 957f108..151f3b0 100644
--- a/gnu/system/installer/hostname.scm
+++ b/gnu/system/installer/hostname.scm
@@ -75,7 +75,8 @@
 
     (cond
      ((buttons-key-matches-symbol? nav ch 'cancel)
-      (page-leave))
+      (page-leave)
+      'cancelled)
 
      ((select-key? ch)
       (set! host-name (form-get-value form 0))
@@ -111,8 +112,7 @@
            (positive? (field-cursor-position (get-current-field form)))))
 
      (else
-      (form-enter form ch)))
-    #f))
+      (form-enter form ch)))))
 
 (define my-buttons `((cancel ,(M_ "Cancel") #f)))
 
diff --git a/gnu/system/installer/levelled-stack.scm 
b/gnu/system/installer/levelled-stack.scm
index 3057300..be1ec3b 100644
--- a/gnu/system/installer/levelled-stack.scm
+++ b/gnu/system/installer/levelled-stack.scm
@@ -59,11 +59,7 @@ tail of the list."
 
 
 (define (page-pop)
-  (set! stack (cdr stack))
-  (when (and (not (null? stack))
-            (not (car stack)))
-       ;; If the top item is #f then page-pop again
-       (page-pop)))
+  (set! stack (cdr stack)))
 
 (define (page-top)
   (if (car stack)
@@ -74,6 +70,5 @@ tail of the list."
   (set! stack (cdr stack))
   (when (not (null? stack))
        (let ((head (car stack)))
-         (if head
-             (page-ppop)
-             (page-pop)))))
+         (when head
+                (page-ppop)))))
diff --git a/gnu/system/installer/role.scm b/gnu/system/installer/role.scm
index 09ebcc0..37f30aa 100644
--- a/gnu/system/installer/role.scm
+++ b/gnu/system/installer/role.scm
@@ -57,11 +57,9 @@
 (define my-buttons `((cancel ,(M_ "Canc_el") #t)))
 
 (define (role-page-key-handler page ch)
-  (let ((menu (page-datum page 'menu))
-       (nav  (page-datum page 'navigation)))
-
-    (cond
-     ((eq? ch KEY_RIGHT)
+  (let* ((menu (page-datum page 'menu))
+         (nav  (page-datum page 'navigation))
+         (result (cond ((eq? ch KEY_RIGHT)
       (menu-set-active! menu #f)
       (buttons-select-next nav))
 
@@ -93,10 +91,11 @@
       (page-leave))
 
      ((buttons-key-matches-symbol? nav ch 'cancel)
-      (page-leave)))
+      (page-leave)
+      'cancelled))))
 
-    (std-menu-key-handler menu ch))
-  #f)
+    (std-menu-key-handler menu ch)
+    result))
 
 
 (define (role-page-refresh page)
diff --git a/gnu/system/installer/time-zone.scm 
b/gnu/system/installer/time-zone.scm
index ff7fbc7..6ad33d1 100644
--- a/gnu/system/installer/time-zone.scm
+++ b/gnu/system/installer/time-zone.scm
@@ -42,11 +42,10 @@
 (define my-buttons `((cancel  ,(M_ "Canc_el") #t)))
 
 (define (time-zone-page-key-handler page ch)
-  (let ((nav  (page-datum page 'navigation))
+  (let* ((nav  (page-datum page 'navigation))
        (menu (page-datum page 'menu))
-       (directory (page-datum page 'directory)))
-
-    (cond
+       (directory (page-datum page 'directory))
+        (result (cond
      ((eq? ch #\tab)
       (cond
        ((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
@@ -56,7 +55,8 @@
        (buttons-select-next nav))))
 
      ((buttons-key-matches-symbol? nav ch 'cancel)
-      (page-leave))
+      (page-leave)
+      'cancelled)
 
      ((and (eqv? ch #\newline)
           (menu-active menu))
@@ -79,9 +79,9 @@
                    i))
              (page-leave)
              #f)))
-      ))
+      ))))
   (std-menu-key-handler menu ch)
-  #f))
+  result))
 
 
 (define (time-zone-page-refresh page)