jmd pushed a commit to branch wip-installer in repository guix. commit 0103bae9299862a15d75eb33d7d377749265a603 Author: John Darrington <j...@gnu.org> 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