04/20: installer: New procedure "page-leave".

[John Darrington]

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

commit 0103bae9299862a15d75eb33d7d377749265a603
Author: John Darrington <address@hidden>
Date:   Fri Jan 6 20:46:09 2017 +0100

    installer: New procedure "page-leave".
    
    * gnu/system/installer/page.scm (page-leave): New procedure.
    * 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/hostname.scm,
    gnu/system/installer/install.scm,
    gnu/system/installer/mount-point.scm,
    gnu/system/installer/network.scm,
    gnu/system/installer/passphrase.scm,
    gnu/system/installer/ping.scm,
    gnu/system/installer/role.scm,
    gnu/system/installer/time-zone.scm,
    gnu/system/installer/wireless.scm: Use it where appropriate.
---
 gnu/system/installer/configure.scm    |    4 ++--
 gnu/system/installer/dialog.scm       |    2 +-
 gnu/system/installer/disks.scm        |    3 +--
 gnu/system/installer/file-browser.scm |    4 ++--
 gnu/system/installer/filesystems.scm  |    5 ++---
 gnu/system/installer/hostname.scm     |    6 ++----
 gnu/system/installer/install.scm      |    2 +-
 gnu/system/installer/mount-point.scm  |    3 +--
 gnu/system/installer/network.scm      |    2 +-
 gnu/system/installer/page.scm         |    6 +++++-
 gnu/system/installer/passphrase.scm   |    7 ++-----
 gnu/system/installer/ping.scm         |    2 +-
 gnu/system/installer/role.scm         |    4 ++--
 gnu/system/installer/time-zone.scm    |    5 ++---
 gnu/system/installer/wireless.scm     |    3 +--
 15 files changed, 26 insertions(+), 32 deletions(-)

diff --git a/gnu/system/installer/configure.scm 
b/gnu/system/installer/configure.scm
index d454488..e0594b6 100644
--- a/gnu/system/installer/configure.scm
+++ b/gnu/system/installer/configure.scm
@@ -97,7 +97,7 @@
      
      ((buttons-key-matches-symbol? nav ch 'back)
       ;; Close the menu and return 
-      (set! page-stack (cdr page-stack)))
+      (page-leave))
 
 
 
@@ -111,7 +111,7 @@
         (close-port cfg-port))
 
       ;; Close the menu and return 
-      (set! page-stack (cdr page-stack)))
+      (page-leave))
      )
 
     #f))
diff --git a/gnu/system/installer/dialog.scm b/gnu/system/installer/dialog.scm
index 2c8f3ed..785c02c 100644
--- a/gnu/system/installer/dialog.scm
+++ b/gnu/system/installer/dialog.scm
@@ -54,7 +54,7 @@
      ((buttons-key-matches-symbol? nav ch 'ok)
 
       (delwin (page-datum page 'text-window))
-      (set! page-stack (cdr page-stack))
+      (page-leave)
       ))
     #f))
 
diff --git a/gnu/system/installer/disks.scm b/gnu/system/installer/disks.scm
index 9a1c8b6..b53dc0a 100644
--- a/gnu/system/installer/disks.scm
+++ b/gnu/system/installer/disks.scm
@@ -94,8 +94,7 @@
         (system* "partprobe")))
 
      ((buttons-key-matches-symbol? nav ch 'continue)
-      (set! page-stack (cdr page-stack))
-      ((page-refresh (car page-stack)) (car page-stack))))
+      (page-leave)))
     
     (std-menu-key-handler menu ch))
 
diff --git a/gnu/system/installer/file-browser.scm 
b/gnu/system/installer/file-browser.scm
index 70fcae3..e0af0ec 100644
--- a/gnu/system/installer/file-browser.scm
+++ b/gnu/system/installer/file-browser.scm
@@ -56,7 +56,7 @@
 
      ((buttons-key-matches-symbol? nav ch 'back)
 
-      (set! page-stack (cdr page-stack)))
+      (page-leave))
 
      ((and (eqv? ch #\newline)
           (menu-active menu))
@@ -70,7 +70,7 @@
            (begin
               (system* "loadkeys" i)
               (set! key-map i)
-              (set! page-stack (page-datum page 'exit-point))
+              (page-leave (page-datum page 'exit-point))
               #f)))))
     (std-menu-key-handler menu ch)
     #f))
diff --git a/gnu/system/installer/filesystems.scm 
b/gnu/system/installer/filesystems.scm
index 0908f52..9631e7e 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -188,7 +188,7 @@
        ))
 
      ((buttons-key-matches-symbol? nav ch 'back)
-      (set! page-stack (cdr page-stack)))
+      (page-leave))
 
 
      ((buttons-key-matches-symbol? nav ch 'continue)
@@ -198,8 +198,7 @@
               (set! page-stack (cons next page-stack))
               ((page-refresh next) next))
             (begin
-              (set! page-stack (cdr page-stack))
-              ((page-refresh (car page-stack)) (car page-stack)))
+              (page-leave))
             ))))
 
     (std-menu-key-handler menu ch))
diff --git a/gnu/system/installer/hostname.scm 
b/gnu/system/installer/hostname.scm
index 3939120..66096cb 100644
--- a/gnu/system/installer/hostname.scm
+++ b/gnu/system/installer/hostname.scm
@@ -69,13 +69,11 @@
 
     (cond
      ((buttons-key-matches-symbol? nav ch 'back)
-      (set! page-stack (cdr page-stack))
-      ((page-refresh (car page-stack)) (car page-stack)))
+      (page-leave))
 
      ((select-key? ch)
       (set! host-name (form-get-value form 0))
-      (set! page-stack (cdr page-stack))
-      ((page-refresh (car page-stack)) (car page-stack)))
+      (page-leave))
 
      ((eq? ch #\tab)
       (form-set-enabled! form #f)
diff --git a/gnu/system/installer/install.scm b/gnu/system/installer/install.scm
index a08b4f8..3ba1327 100644
--- a/gnu/system/installer/install.scm
+++ b/gnu/system/installer/install.scm
@@ -70,7 +70,7 @@
 
      ((buttons-key-matches-symbol? nav ch 'back)
       ;; Close the menu and return
-      (set! page-stack (cdr page-stack)))
+      (page-leave))
 
      ((buttons-key-matches-symbol? nav ch 'reboot)
       (system* "reboot"))
diff --git a/gnu/system/installer/mount-point.scm 
b/gnu/system/installer/mount-point.scm
index 632b81d..2468ba2 100644
--- a/gnu/system/installer/mount-point.scm
+++ b/gnu/system/installer/mount-point.scm
@@ -71,8 +71,7 @@
                     (set! mount-points (assoc-set! mount-points
                                                    dev mp))))
 
-             (set! page-stack (cdr page-stack))
-             ((page-refresh (car page-stack)) (car page-stack)))
+             (page-leave))
 
             ((buttons-key-matches-symbol? nav ch 'check)
              (window-pipe (page-datum page 'output) "fsck.ext4" "fsck.ext4" 
"-n" "-v"
diff --git a/gnu/system/installer/network.scm b/gnu/system/installer/network.scm
index 7eb4807..d59bbda 100644
--- a/gnu/system/installer/network.scm
+++ b/gnu/system/installer/network.scm
@@ -116,7 +116,7 @@
       ;; Cancel the timer
       (setitimer ITIMER_REAL 0 0 0 0)
 
-      (set! page-stack (cdr page-stack))))
+      (page-leave)))
 
     (std-menu-key-handler menu ch))
   #f)
diff --git a/gnu/system/installer/page.scm b/gnu/system/installer/page.scm
index e17326c..59361d1 100644
--- a/gnu/system/installer/page.scm
+++ b/gnu/system/installer/page.scm
@@ -23,7 +23,7 @@
   #:export (page-refresh)
   #:export (page-initialised?)
   #:export (page-set-initialised!)
-  #:export (page-stack)
+  #:export (page-leave)
   #:export (page-set-wwin!)
   #:export (page-wwin)
   #:export (page-title)
@@ -54,3 +54,7 @@
 
 (define (page-datum page key)
   (assq-ref (page-data page) key))
+
+(define* (page-leave #:optional (return-point #f))
+  (set! page-stack
+    (or return-point (cdr page-stack))))
diff --git a/gnu/system/installer/passphrase.scm 
b/gnu/system/installer/passphrase.scm
index f7b165b..42b7b0c 100644
--- a/gnu/system/installer/passphrase.scm
+++ b/gnu/system/installer/passphrase.scm
@@ -66,8 +66,7 @@
 
     (cond
      ((buttons-key-matches-symbol? nav ch 'back)
-      (set! page-stack (cdr page-stack))
-      ((page-refresh (car page-stack)) (car page-stack)))
+      (page-leave))
 
      ((eq? ch #\tab)
       (form-set-enabled! form #f)
@@ -86,9 +85,7 @@
        (page-datum page 'ifce)
        (page-datum page 'network)
        (form-get-value form 'passphrase))
-
-      (set! page-stack (cdr (cdr page-stack)))
-      ((page-refresh (car page-stack)) (car page-stack)))
+      (page-leave (cdr (cdr page-stack))))
 
      (else
       (form-enter form ch)))
diff --git a/gnu/system/installer/ping.scm b/gnu/system/installer/ping.scm
index 1afb2cf..e4bef7a 100644
--- a/gnu/system/installer/ping.scm
+++ b/gnu/system/installer/ping.scm
@@ -74,7 +74,7 @@
      ((buttons-key-matches-symbol? nav ch 'continue)
 
       (delwin (page-datum page 'test-window))
-      (set! page-stack (cdr page-stack))
+      (page-leave)
       )
 
      ((buttons-key-matches-symbol? nav ch 'test)
diff --git a/gnu/system/installer/role.scm b/gnu/system/installer/role.scm
index 369f695..9d4baf4 100644
--- a/gnu/system/installer/role.scm
+++ b/gnu/system/installer/role.scm
@@ -88,10 +88,10 @@
      ((select-key? ch)
       (set! system-role (menu-get-current-item menu))
       
-      (set! page-stack (cdr page-stack)))
+      (page-leave))
 
      ((buttons-key-matches-symbol? nav ch 'back)
-      (set! page-stack (cdr page-stack))))
+      (page-leave)))
 
     (std-menu-key-handler menu ch))
   #f)
diff --git a/gnu/system/installer/time-zone.scm 
b/gnu/system/installer/time-zone.scm
index 416067f..00f2858 100644
--- a/gnu/system/installer/time-zone.scm
+++ b/gnu/system/installer/time-zone.scm
@@ -55,8 +55,7 @@
        (buttons-select-next nav))))
 
      ((buttons-key-matches-symbol? nav ch 'back)
-
-      (set! page-stack (cdr page-stack)))
+      (page-leave))
 
      ((and (eqv? ch #\newline)
           (menu-active menu))
@@ -78,7 +77,7 @@
                (if (page-datum page 'stem)
                    (string-append (page-datum page 'stem) "/" i)
                    i))
-             (set! page-stack (page-datum page 'exit-point))
+             (page-leave (page-datum page 'exit-point))
              #f)))
       ))
   (std-menu-key-handler menu ch)
diff --git a/gnu/system/installer/wireless.scm 
b/gnu/system/installer/wireless.scm
index 8615004..dda9195 100644
--- a/gnu/system/installer/wireless.scm
+++ b/gnu/system/installer/wireless.scm
@@ -70,8 +70,7 @@
       (buttons-unselect-all nav))
 
      ((buttons-key-matches-symbol? nav ch 'back)
-      (set! page-stack (cdr page-stack))
-      ((page-refresh (car page-stack)) (car page-stack)))
+      (page-leave))
 
      ((select-key? ch)
       (let ((next (make-passphrase-page