[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/01: installer: Provide event handlers with the event data.
|
From: |
Danny Milosavljevic |
|
Subject: |
01/01: installer: Provide event handlers with the event data. |
|
Date: |
Fri, 7 Jul 2017 09:56:26 -0400 (EDT) |
dannym pushed a commit to branch wip-installer-2
in repository guix.
commit e1944bf7bd1b08f4967fc925a5818bc18dd2813a
Author: Danny Milosavljevic <address@hidden>
Date: Fri Jul 7 15:38:18 2017 +0200
installer: Provide event handlers with the event data.
* gnu/system/installer/configure.scm
(configure-page-activate-selected-item):
Rename to...
(configure-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-configure-page): Use it here.
* gnu/system/installer/disks.scm (disk-page-activate-selected-item):
Rename to...
(disk-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-disk-page): Use it here.
* gnu/system/installer/filesystems.scm
(filesystem-page-activate-selected-item): Rename to...
(filesystem-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-filesystem-page): Use it here.
* gnu/system/installer/format.scm (format-page-activate-selected-item):
Rename to...
(format-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-format-page): Use it here.
* gnu/system/installer/guixsd-installer.scm
(main-page-activate-selected-item): Rename to...
(main-page-activate-item): ...this. And adapt it to use the passed
event data.
(guixsd-installer): Use it here.
* gnu/system/installer/hostname.scm (host-name-mouse-handler):
Delete variable.
(host-name-key-handler): Delete variable.
(host-name-activate-item): New variable. Lose hostname length limit check
for now.
(make-host-name-page): Use it here.
* gnu/system/installer/install.scm (install-page-mouse-handler): Delete
variable.
(install-page-key-handler): Delete variable.
(install-page-activate-item): New variable.
(make-install-page): Use it here.
* gnu/system/installer/key-map.scm (key-map-page-activate-selected-item):
Rename to...
(key-map-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-key-map): Use it here.
* gnu/system/installer/locale.scm (locale-page-activate-selected-item):
Rename to...
(locale-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-locale-page): Use it here.
* gnu/system/installer/mount-point.scm
(mount-point-page-activate-selected-item): Rename to...
(mount-point-page-activate-item): ...this. And adapt it to use the passed
event data. Export it.
* gnu/system/installer/network.scm (network-page-activate-selected-item):
Rename to...
(network-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-network-page): Use it here.
* gnu/system/installer/page.scm (page-activate-selected-item):
Rename to....
(page-activate-item): ...this. And adapt it to use the passed event
data.
(page-default-mouse-handler): Simplify implementation.
(page-default-key-handler): Simplify implementation.
* gnu/system/installer/ping.scm (ping-page-activate-selected-item):
Rename to...
(ping-page-activate-item): ...this. And adapt it to use the passed
event data. Export it.
* gnu/system/installer/role.scm (role-page-activate-selected-item):
Rename to...
(role-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-role-page): Use it here.
* gnu/system/installer/time-zone.scm
(time-zone-page-activate-selected-item): Rename to...
(time-zone-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-tz-browser): Use it here.
* gnu/system/installer/user-edit.scm
(user-edit-page-activate-selected-item): Rename to...
(user-edit-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-user-edit-page): Use it here.
* gnu/system/installer/users.scm (users-page-activate-selected-item):
Rename to...
(users-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-users-page): Use it here.
* gnu/system/installer/wireless.scm (wireless-page-activate-selected-item):
Rename to...
(wireless-page-activate-item): ...this. And adapt it to use the passed
event data.
(make-wireless-page): Use it here.
* gurses/menu.scm (std-menu-key-handler): Replace 'ignored by #f.
(std-menu-mouse-handler): Replace 'ignored by #f.
---
gnu/system/installer/configure.scm | 14 +++----
gnu/system/installer/disks.scm | 24 +++++------
gnu/system/installer/filesystems.scm | 38 ++++++++----------
gnu/system/installer/format.scm | 31 +++++++--------
gnu/system/installer/guixsd-installer.scm | 15 ++++---
gnu/system/installer/hostname.scm | 43 ++++++--------------
gnu/system/installer/install.scm | 48 ++++++++--------------
gnu/system/installer/key-map.scm | 25 ++++++------
gnu/system/installer/locale.scm | 23 ++++++-----
gnu/system/installer/mount-point.scm | 8 ++--
gnu/system/installer/network.scm | 46 +++++++++++----------
gnu/system/installer/page.scm | 66 +++++++++++++++++--------------
gnu/system/installer/ping.scm | 10 ++---
gnu/system/installer/role.scm | 23 +++++------
gnu/system/installer/time-zone.scm | 22 +++++------
gnu/system/installer/user-edit.scm | 11 +++---
gnu/system/installer/users.scm | 47 +++++++++++-----------
gnu/system/installer/wireless.scm | 50 +++++++++++------------
gurses/menu.scm | 10 ++---
19 files changed, 259 insertions(+), 295 deletions(-)
diff --git a/gnu/system/installer/configure.scm
b/gnu/system/installer/configure.scm
index 29296a8..0949b39 100644
--- a/gnu/system/installer/configure.scm
+++ b/gnu/system/installer/configure.scm
@@ -45,7 +45,7 @@
title
configure-page-refresh
0
- #:activator configure-page-activate-selected-item)))
+ #:activator configure-page-activate-item)))
page))
@@ -75,16 +75,14 @@
""
"/tmp"))
-(define (configure-page-activate-selected-item page)
- (let ((nav (page-datum page 'navigation))
- (test-window (page-datum page 'test-window)))
- (match (buttons-selected-symbol nav)
- ('cancel
+(define (configure-page-activate-item page item)
+ (match item
+ ('cancel
;; Close the menu and return
(page-leave)
'cancelled)
- ('save
+ ('save
;; Write the configuration and set the file name
(let ((cfg-port (mkstemp! (string-copy
(string-append tempdir
"/guix-config-XXXXXX")))))
@@ -94,7 +92,7 @@
;; Close the menu and return
(page-leave))
- (_ 'ignored))))
+ (_ 'ignored)))
(define (configure-page-refresh page)
(when (not (page-initialised? page))
diff --git a/gnu/system/installer/disks.scm b/gnu/system/installer/disks.scm
index e2c67ff..3cba612 100644
--- a/gnu/system/installer/disks.scm
+++ b/gnu/system/installer/disks.scm
@@ -25,6 +25,7 @@
#:use-module (gurses buttons)
#:use-module (ncurses curses)
#:use-module (ice-9 format)
+ #:use-module (ice-9 match)
#:export (make-disk-page))
(include "i18n.scm")
@@ -36,7 +37,7 @@
title
disk-page-refresh
0
- #:activator disk-page-activate-selected-item))
+ #:activator disk-page-activate-item))
(define (disk-page-refresh page)
(when (not (page-initialised? page))
@@ -57,17 +58,16 @@
(menu-redraw menu)
(menu-refresh menu)))
-(define (disk-page-activate-selected-item page)
- (let ((menu (page-datum page 'menu)))
- (cond
- ((menu-active menu)
- (let* ((menu (page-datum page 'menu))
- (i (menu-current-item menu)))
- (endwin)
- (system* "cfdisk" (disk-name (list-ref (menu-items menu) i)))
- (system* "partprobe")))
- (else ; "Continue" button activated
- (page-leave)))))
+(define (disk-page-activate-item page item)
+ (match item
+ (('menu-item-activated i)
+ (endwin)
+ (system* "cfdisk" (disk-name i))
+ (system* "partprobe")
+ 'handled)
+ (else ; "Continue" button activated
+ (page-leave)
+ 'handled)))
(define (truncate-string ss w)
(if (> (string-length ss) w)
diff --git a/gnu/system/installer/filesystems.scm
b/gnu/system/installer/filesystems.scm
index 9770467..bdccf2b 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -131,7 +131,7 @@
title
filesystem-page-refresh
0
- #:activator filesystem-page-activate-selected-item))
+ #:activator filesystem-page-activate-item))
(define my-buttons `((continue ,(M_ "_Continue") #t)
(cancel ,(M_ "Canc_el") #t)))
@@ -179,34 +179,30 @@
(error (format #f "~s is not a partition" p)))
p)))
-(define (filesystem-page-activate-selected-item page)
- (let* ((menu (page-datum page 'menu)))
- (cond
- ((menu-active menu)
- (let* ((dev (list-ref (menu-items menu) (menu-current-item menu)))
- (name (partition-name (car dev)))
+(define (filesystem-page-activate-item page item)
+ (match item
+ (('menu-item-activated dev)
+ (let* ((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
- #:activator
mount-point-page-activate-selected-item)))
+ #:activator mount-point-page-activate-item)))
(page-set-datum! next 'device name)
(page-enter next)
'handled))
- (else ; buttons
- (match (buttons-selected-symbol (page-datum page 'navigation))
- ('cancel
- (page-leave)
- 'cancelled)
- ('continue
- (let ((errstr (filesystem-task-incomplete-reason)))
- (if errstr
- (let ((next (make-dialog page errstr)))
- (page-enter next))
- (page-leave)))
- 'handled)
- (_ 'ignored))))))
+ ('cancel
+ (page-leave)
+ 'cancelled)
+ ('continue
+ (let ((errstr (filesystem-task-incomplete-reason)))
+ (if errstr
+ (let ((next (make-dialog page errstr)))
+ (page-enter next))
+ (page-leave)))
+ 'handled)
+ (_ 'ignored)))
(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 bc409da..71584af 100644
--- a/gnu/system/installer/format.scm
+++ b/gnu/system/installer/format.scm
@@ -65,23 +65,22 @@ match those uuids read from the respective partitions"
title
format-page-refresh
0
- #:activator format-page-activate-selected-item)))
+ #:activator format-page-activate-item)))
page))
(define my-buttons `((format ,(M_ "_Format") #t)
(cancel ,(M_ "Canc_el") #t)))
-(define (format-page-activate-selected-item page)
- (let ((nav (page-datum page 'navigation))
- (config-window (page-datum page 'config-window)))
- (match (buttons-selected-symbol nav)
- ('cancel
- ;; Close the menu and return
- (page-leave)
- 'cancelled)
- ('format
- (let ((window-port (make-window-port config-window)))
- (for-each
+(define (format-page-activate-item page item)
+ (let ((config-window (page-datum page 'config-window)))
+ (match item
+ ('cancel
+ ;; Close the menu and return
+ (page-leave)
+ 'cancelled)
+ ('format
+ (let ((window-port (make-window-port config-window)))
+ (for-each
(lambda (x)
(match x
((dev . ($ <file-system-spec> mp label type uuid))
@@ -118,10 +117,10 @@ match those uuids read from the respective partitions"
(close-port window-port))
- (when (filesystems-are-current?)
- (page-leave))
- 'handled)
- (_ 'ignored))))
+ (when (filesystems-are-current?)
+ (page-leave))
+ 'handled)
+ (_ 'ignored))))
(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 463d2a3..945929a 100644
--- a/gnu/system/installer/guixsd-installer.scm
+++ b/gnu/system/installer/guixsd-installer.scm
@@ -212,12 +212,15 @@
(do-task task-name page))))
task-name-list))
-(define (main-page-activate-selected-item page)
- (let* ((main-menu (page-datum page 'menu))
- (item (menu-get-current-item main-menu)))
- (do-task (car item) page)
+(define (main-page-activate-item page item)
+ (match item
+ (#f #f)
+ (('menu-item-activated x)
+ (do-task (car x) page)
(page-uniquify)
- ((page-refresh (car stack)) (car stack))))
+ ((page-refresh (car stack)) (car stack))
+ 'handled)
+ (_ #f)))
(define (main-page-init page)
(let* ((frame (make-boxed-window (page-surface page) (lines) (cols) 0 0
@@ -320,7 +323,7 @@
(let ((page (make-page
stdscr (gettext "GuixSD Installer")
main-page-refresh 0
- #:activator main-page-activate-selected-item)))
+ #:activator main-page-activate-item)))
(page-enter page)
(page-push #f)
(let loop ((ch (getch stdscr)))
diff --git a/gnu/system/installer/hostname.scm
b/gnu/system/installer/hostname.scm
index 3e8317d..57045ca 100644
--- a/gnu/system/installer/hostname.scm
+++ b/gnu/system/installer/hostname.scm
@@ -25,6 +25,7 @@
#:use-module (gurses buttons)
#:use-module (ncurses curses)
#:use-module (ice-9 regex)
+ #:use-module (ice-9 match)
#:export (valid-hostname?)
#:export (make-host-name-page))
@@ -48,8 +49,7 @@
title
host-name-refresh
1
- host-name-key-handler
- host-name-mouse-handler))
+ #:activator host-name-activate-item))
(define (host-name-refresh page)
(when (not (page-initialised? page))
@@ -69,36 +69,21 @@
(refresh* (outer (page-wwin page)))
(refresh* (form-window form))))
-(define (host-name-mouse-handler page device-id x y z button-state)
- 'ignored)
-
-(define (host-name-key-handler page ch)
+(define (host-name-activate-item page item)
(let ((form (page-datum page 'form))
(nav (page-datum page 'navigation))
(dev (page-datum page 'device)))
-
- (cond
- ((buttons-key-matches-symbol? nav ch 'cancel)
- (page-leave)
- 'cancelled)
-
- ((select-key? ch)
+ (match item
+ ('default
(set! host-name (form-get-value form 0))
- (page-leave))
-
- ((eq? ch #\tab)
- (form-set-enabled! form #f)
- (buttons-select-next nav))
-
- ((eq? ch KEY_UP)
- (buttons-unselect-all nav)
- (form-set-enabled! form #t))
-
- ((eq? ch KEY_DOWN)
- (buttons-unselect-all nav)
- (form-set-enabled! form #t))
+ (page-leave)
+ 'handled)
+ ('cancel
+ (page-leave)
+ 'cancelled)
+ (_ 'ignored))))
- ;; Do not allow more than 63 characters
+#| ;; Do not allow more than 63 characters
((and (char? ch)
(char-set-contains? char-set:printing ch)
(>= (field-cursor-position (get-current-field form)) max-length)))
@@ -114,9 +99,7 @@
(not (char-set-contains?
(char-set-adjoin char-set:letter+digit #\-) ch))
(positive? (field-cursor-position (get-current-field form)))))
-
- (else
- (form-enter form ch)))))
+|#
(define my-buttons `((cancel ,(M_ "Cancel") #f)))
diff --git a/gnu/system/installer/install.scm b/gnu/system/installer/install.scm
index 00656fe..201bdfc 100644
--- a/gnu/system/installer/install.scm
+++ b/gnu/system/installer/install.scm
@@ -41,8 +41,8 @@
title
install-page-refresh
0
- install-page-key-handler
- install-page-mouse-handler)))
+ #:activator
+ install-page-activate-item)))
page))
@@ -75,41 +75,24 @@
(define (install-page-mouse-handler page device-id x y z button-state)
'ignored)
-(define (install-page-key-handler page ch)
- (let ((nav (page-datum page 'navigation))
- (config-window (page-datum page 'config-window)))
-
- (cond
- ((eq? ch KEY_RIGHT)
- (buttons-select-next nav))
-
- ((eq? ch #\tab)
- (cond
- ((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
- (buttons-unselect-all nav))
-
- (else
- (buttons-select-next nav))))
-
- ((eq? ch KEY_LEFT)
- (buttons-select-prev nav))
-
- ((eq? ch KEY_UP)
- (buttons-unselect-all nav))
-
-
- ((buttons-key-matches-symbol? nav ch 'cancel)
+(define (install-page-activate-item page item)
+ (let ((config-window (page-datum page 'config-window)))
+ (match item
+ ('cancel
;; Close the menu and return
- (page-leave))
+ (page-leave)
+ 'handled)
- ((buttons-key-matches-symbol? nav ch 'reboot)
- (force-reboot))
+ ('reboot
+ (force-reboot)
+ 'handled)
- ((buttons-key-matches-symbol? nav ch 'continue)
+ ('continue
(let ((target (format #f "/target-~a" install-attempts))
(window-port (make-window-port config-window)))
(catch #t
(lambda ()
+ (force-output window-port)
(set! install-attempts (1+ install-attempts))
(and
(fold
@@ -157,8 +140,9 @@
(display-error (stack-ref (make-stack #t) 3)
window-port subr message args rest)))
- (close-port window-port))))
- #f))
+ (close-port window-port))
+ 'handled)
+ (_ 'ignored))))
(define (install-page-refresh page)
(when (not (page-initialised? page))
diff --git a/gnu/system/installer/key-map.scm b/gnu/system/installer/key-map.scm
index e42da40..8c80ff1 100644
--- a/gnu/system/installer/key-map.scm
+++ b/gnu/system/installer/key-map.scm
@@ -35,20 +35,18 @@
(gettext "Keyboard Mapping")
key-map-page-refresh
0
- #:activator key-map-page-activate-selected-item)))
+ #:activator key-map-page-activate-item)))
(page-set-datum! page 'directory directory)
page))
(define my-buttons `((cancel ,(M_ "Canc_el") #t)))
-(define (key-map-page-activate-selected-item page)
- (let* ((menu (page-datum page 'menu))
- (i (menu-get-current-item menu))
- (directory (page-datum page 'directory))
- (new-dir (string-append directory "/" i)))
- (cond
- ((menu-active menu)
+(define (key-map-page-activate-item page item)
+ (match item
+ (('menu-item-activated i)
+ (let* ((directory (page-datum page 'directory))
+ (new-dir (string-append directory "/" i)))
(if (eq? 'directory (stat:type (stat new-dir)))
(let ((p (make-key-map page new-dir)))
(page-pop) ; Don't go back to the current page!
@@ -57,12 +55,11 @@
(system* "loadkeys" i)
(set! key-map i)
(page-leave)
- #f)))
- (else ;buttons
- (match (buttons-selected-symbol (page-datum page 'navigation))
- ('cancel
- (page-leave))
- (_ 'ignored))))))
+ 'handled))))
+ ('cancel
+ (page-leave)
+ 'handled)
+ (_ 'ignored)))
(define (key-map-page-refresh page)
(when (not (page-initialised? page))
diff --git a/gnu/system/installer/locale.scm b/gnu/system/installer/locale.scm
index fbb5766..80d6c87 100644
--- a/gnu/system/installer/locale.scm
+++ b/gnu/system/installer/locale.scm
@@ -25,6 +25,7 @@
#:use-module (gurses buttons)
#:use-module (ncurses curses)
#:use-module (ice-9 format)
+ #:use-module (ice-9 match)
#:export (make-locale-page))
(include "i18n.scm")
@@ -36,7 +37,7 @@
title
locale-page-refresh
0
- #:activator locale-page-activate-selected-item))
+ #:activator locale-page-activate-item))
(define (locale-page-refresh page)
(when (not (page-initialised? page))
@@ -56,15 +57,17 @@
(menu-redraw menu)
(menu-refresh menu)))
-(define (locale-page-activate-selected-item page)
- (let* ((menu (page-datum page 'menu))
- (locale (menu-get-current-item menu)))
- (cond
- ((menu-active menu)
- (setlocale LC_ALL (locale-definition-name locale))
- (page-leave))
- (else ; "Cancel" button
- (page-leave)))))
+(define (locale-page-activate-item page item)
+ (match item
+ (('menu-item-activated locale)
+ (setlocale LC_ALL (locale-definition-name locale))
+ (page-leave)
+ 'handled)
+ ('cancel
+ (page-leave)
+ 'handled)
+ (_
+ 'ignored)))
(define (locale-description locale)
"Return a string describing LOCALE"
diff --git a/gnu/system/installer/mount-point.scm
b/gnu/system/installer/mount-point.scm
index 0be8817..204d3ad 100644
--- a/gnu/system/installer/mount-point.scm
+++ b/gnu/system/installer/mount-point.scm
@@ -28,7 +28,7 @@
#:use-module (ice-9 match)
#:export (mount-point-refresh)
- #:export (mount-point-page-activate-selected-item))
+ #:export (mount-point-page-activate-item))
(include "i18n.scm")
@@ -45,13 +45,13 @@
(refresh* (outer (page-wwin page)))
(refresh* (form-window form))))
-(define (mount-point-page-activate-selected-item page)
+(define (mount-point-page-activate-item page item)
(let ((form (page-datum page 'form))
(nav (page-datum page 'navigation))
(dev (page-datum page 'device)))
- (match (if (form-enabled? form)
+ (match (if (eq? item 'default)
'continue
- (buttons-selected-symbol nav))
+ item)
('continue
(let ((fss
(make-file-system-spec
diff --git a/gnu/system/installer/network.scm b/gnu/system/installer/network.scm
index 6c7981c..3379734 100644
--- a/gnu/system/installer/network.scm
+++ b/gnu/system/installer/network.scm
@@ -47,7 +47,7 @@
title
network-page-refresh
0
- #:activator network-page-activate-selected-item))
+ #:activator network-page-activate-item))
(define (interfaces)
(map (lambda (ifce)
@@ -98,14 +98,11 @@
(define my-buttons `((continue ,(M_ "_Continue") #t)
(test ,(M_ "_Test") #t)))
-(define (network-page-activate-selected-item page)
- (let* ((menu (page-datum page 'menu))
- (nav (page-datum page 'navigation))
- (item (menu-get-current-item menu))
- (item-name (and item (assq-ref item 'name)))
- (item-class (and item (assq-ref item 'class))))
- (cond
- ((menu-active menu)
+(define (network-page-activate-item page xitem)
+ (match xitem
+ (('menu-item-activated item)
+ (let ((item-name (and item (assq-ref item 'name)))
+ (item-class (and item (assq-ref item 'class))))
(match item-class
('wireless
(let ((next (make-wireless-page page (M_ "Wireless interface setup")
@@ -114,21 +111,22 @@
('ethernet
(and (zero? (system* "ip" "link" "set" item-name "up"))
(dhclient item-name)))
- (_ 'ignored)))
- (else
- (match (buttons-selected-symbol nav)
- ('test
- (let ((next (make-page (page-surface page)
- "Ping"
- ping-page-refresh
- 0
- #:activator
ping-page-activate-selected-item)))
- (page-enter next)))
- ('continue
- ;; Cancel the timer
- (setitimer ITIMER_REAL 0 0 0 0)
- (page-leave))
- (_ #f))))))
+ (_ 'x))
+ 'handled))
+ ('test
+ (let ((next (make-page (page-surface page)
+ "Ping"
+ ping-page-refresh
+ 0
+ #:activator ping-page-activate-item)))
+ (page-enter next)
+ 'handled))
+ ('continue
+ ;; Cancel the timer
+ (setitimer ITIMER_REAL 0 0 0 0)
+ (page-leave)
+ 'handled)
+ (_ #f)))
(define (network-page-refresh page)
(when (not (page-initialised? page))
diff --git a/gnu/system/installer/page.scm b/gnu/system/installer/page.scm
index f24e430..5a612b7 100644
--- a/gnu/system/installer/page.scm
+++ b/gnu/system/installer/page.scm
@@ -41,7 +41,8 @@
#:use-module (ncurses curses)
#:use-module (gnu system installer utils)
#:use-module (gnu system installer levelled-stack)
- #:use-module (srfi srfi-9))
+ #:use-module (srfi srfi-9)
+ #:use-module (ice-9 match))
(define-record-type <page>
(make-page' surface title inited refresh cursor-visibility key-handler
mouse-handler data)
@@ -56,27 +57,30 @@
(wwin page-wwin page-set-wwin!)
(data page-data page-set-data!))
-(define (page-activate-selected-item page)
- ((page-datum page 'activator) page))
+(define (page-activate-item page info)
+ ((page-datum page 'activator) page info))
(define (page-default-mouse-handler page device-id x y z button-state)
(let* ((menu (page-datum page 'menu))
- (status (if menu
- (std-menu-mouse-handler menu device-id x y z button-state)
- 'ignored))
(buttons (page-datum page 'navigation))
- (status (if (and (eq? status 'ignored) buttons)
- (let ((button-status (buttons-mouse-handler buttons
- device-id
- x y z
-
button-state)))
- (if (and menu (eq? button-status 'activated))
- (menu-set-active! menu #f))
- button-status)
- status)))
- (if (eq? status 'activated)
- (page-activate-selected-item page))
- status))
+ (status (or (let ((status (std-menu-mouse-handler menu device-id x y
z button-state)))
+ (match status
+ (('menu-item-activated x)
+ (list 'menu-item-activated x))
+ (_ #f)))
+ (if buttons
+ (match
(buttons-mouse-handler buttons device-id x y z button-state)
+ (#f #f)
+ ('ignored #f)
+ (x
+ ;(if menu
+ ; (menu-set-active!
menu #f))
+ x))))))
+ (if status
+ (begin
+ (page-activate-item page status)
+ 'handled)
+ 'ignored)))
(define (page-default-key-handler page ch)
"Handle keypresses in a commonly-used page.
@@ -135,9 +139,13 @@ If a form is used it's assumed that the menu is not used
and vice versa."
'handled)))
((select-key? ch)
- (page-activate-selected-item page))
+ (page-activate-item page
+ (if (and menu (menu-active menu))
+ (list 'menu-item-activated
+ (menu-get-current-item menu))
+ 'default)))
- ((and menu (menu-active menu) (not (eq? 'ignored (std-menu-key-handler
menu ch))))
+ ((and menu (menu-active menu) (std-menu-key-handler menu ch))
'handled)
((eq? ch KEY_UP)
@@ -161,20 +169,18 @@ If a form is used it's assumed that the menu is not used
and vice versa."
((and nav (char? ch)
(or (buttons-fetch-by-key nav (char-upcase ch))
(buttons-fetch-by-key nav (char-downcase ch))))
- (buttons-select-by-symbol nav (or (buttons-fetch-by-key nav
- (char-upcase ch))
- (buttons-fetch-by-key nav
- (char-downcase
ch))))
- (if menu
- (menu-set-active! menu #f)
- (if form
- (form-set-enabled! form #f)))
- (page-activate-selected-item page))
+ (let ((button (or (buttons-fetch-by-key nav (char-upcase ch))
+ (buttons-fetch-by-key nav (char-downcase ch)))))
+ (if menu
+ (menu-set-active! menu #f)
+ (if form
+ (form-set-enabled! form #f)))
+ (buttons-select-by-symbol nav button)
+ (page-activate-item page button)))
(else
'ignored))))
-
(define* (make-page surface title refresh cursor-visibility
#:optional
(key-handler page-default-key-handler)
diff --git a/gnu/system/installer/ping.scm b/gnu/system/installer/ping.scm
index 122bd7b..56f1fb1 100644
--- a/gnu/system/installer/ping.scm
+++ b/gnu/system/installer/ping.scm
@@ -27,10 +27,11 @@
#:use-module (ncurses curses)
#:use-module (web uri)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (substitute-is-reachable?)
#:export (ping-page-refresh)
- #:export (ping-page-activate-selected-item))
+ #:export (ping-page-activate-item))
(include "i18n.scm")
@@ -51,10 +52,9 @@
(continue ,(M_ "_Continue") #t)
(cancel ,(M_ "Canc_el") #t)))
-(define (ping-page-activate-selected-item page)
- (let ((nav (page-datum page 'navigation))
- (test-window (page-datum page 'test-window)))
- (match (buttons-selected-symbol nav)
+(define (ping-page-activate-item page item)
+ (let ((test-window (page-datum page 'test-window)))
+ (match item
('cancel
;; Close the menu and return
(page-leave)
diff --git a/gnu/system/installer/role.scm b/gnu/system/installer/role.scm
index 0c6c904..d3d2e54 100644
--- a/gnu/system/installer/role.scm
+++ b/gnu/system/installer/role.scm
@@ -46,24 +46,25 @@
(service-modules role-service-modules))
-(define (make-role-page parent title)
+(define (make-role-page parent title)
(make-page (page-surface parent)
title
role-page-refresh
0
- #:activator role-page-activate-selected-item))
+ #:activator role-page-activate-item))
(define my-buttons `((cancel ,(M_ "Canc_el") #t)))
-(define (role-page-activate-selected-item page)
- (let ((menu (page-datum page 'menu)))
- (cond
- ((menu-active menu)
- (set! system-role (menu-get-current-item menu))
- (page-leave))
- (else ; buttons
- (page-leave)
- 'cancelled))))
+(define (role-page-activate-item page item)
+ (match item
+ (('menu-item-activated r)
+ (set! system-role r)
+ (page-leave)
+ 'handled)
+ ('cancel
+ (page-leave)
+ 'cancelled)
+ (_ 'ignored)))
(define (role-page-refresh page)
(when (not (page-initialised? page))
diff --git a/gnu/system/installer/time-zone.scm
b/gnu/system/installer/time-zone.scm
index 6c0bd8f..396dcfb 100644
--- a/gnu/system/installer/time-zone.scm
+++ b/gnu/system/installer/time-zone.scm
@@ -35,20 +35,18 @@
(gettext "Time Zone")
time-zone-page-refresh
0
- #:activator time-zone-page-activate-selected-item)))
+ #:activator time-zone-page-activate-item)))
(page-set-datum! page 'directory directory)
page))
(define my-buttons `((cancel ,(M_ "Canc_el") #t)))
-(define (time-zone-page-activate-selected-item page)
- (let* ((menu (page-datum page 'menu)))
- (cond
- ((menu-active menu)
- (time-zone-page-refresh page)
- (let* ((i (menu-get-current-item menu))
- (directory (page-datum page 'directory))
+(define (time-zone-page-activate-item page item)
+ (match item
+ (('menu-item-activated i)
+ (time-zone-page-refresh page) ; FIXME remove
+ (let* ((directory (page-datum page 'directory))
(new-dir (string-append directory "/" i))
(st (lstat new-dir)))
(if (and (file-exists? new-dir)
@@ -67,9 +65,11 @@
i))
(page-leave)
#f))))
- (else ; buttons
- (page-leave)
- 'cancelled))))
+ ('cancel
+ (page-leave)
+ 'cancelled)
+ (_
+ 'ignored)))
(define (time-zone-page-refresh page)
(when (not (page-initialised? page))
diff --git a/gnu/system/installer/user-edit.scm
b/gnu/system/installer/user-edit.scm
index d0d13c1..e72387b 100644
--- a/gnu/system/installer/user-edit.scm
+++ b/gnu/system/installer/user-edit.scm
@@ -41,7 +41,7 @@
title
user-edit-refresh
1
- #:activator user-edit-page-activate-selected-item)))
+ #:activator user-edit-page-activate-item)))
(page-set-datum! page 'account account)
(page-set-datum! page 'parent parent)
page))
@@ -55,14 +55,12 @@
(refresh* (outer (page-wwin page)))
(refresh* (form-window form))))
-(define (user-edit-page-activate-selected-item page)
+(define (user-edit-page-activate-item page item)
(let ((form (page-datum page 'form))
(nav (page-datum page 'navigation))
(parent (page-datum page 'parent))
(dev (page-datum page 'device)))
- (match (if (form-enabled? form)
- 'save
- (buttons-selected-symbol nav))
+ (match (if (eq? item 'default) 'save item)
('save
(set! users
(cons
@@ -82,7 +80,8 @@
('cancel
(page-leave)
'handled)
- (_ 'ignored))))
+ (_
+ 'ignored))))
(define my-buttons `((save ,(M_ "Save") #f)
(cancel ,(M_ "Cancel") #f)))
diff --git a/gnu/system/installer/users.scm b/gnu/system/installer/users.scm
index 2b95b76..b1041bd 100644
--- a/gnu/system/installer/users.scm
+++ b/gnu/system/installer/users.scm
@@ -40,34 +40,35 @@
title
users-page-refresh
0
- #:activator users-page-activate-selected-item))
+ #:activator users-page-activate-item))
(define my-buttons `((add ,(M_ "_Add") #t)
(delete ,(M_ "_Delete") #t)
(continue ,(M_ "_Continue") #t)))
-(define (users-page-activate-selected-item page)
- (let ((menu (page-datum page 'menu))
- (nav (page-datum page 'navigation)))
- (cond
- ((menu-active menu)
- (let* ((account (menu-get-current-item menu)))
- (if account
- (page-enter (make-user-edit-page page "Edit User"
account)))))
-
- (else
- (match (buttons-selected-symbol nav)
- ('add
- (let* ((next (make-user-edit-page page "Add New User" #f)))
- (page-enter next)))
- ('continue
- (page-leave))
- ('delete
- (set! users (remove (lambda (user)
- (equal? user (menu-get-current-item menu)))
- users))
- (page-set-initialised! page #f))
- (_ 'ignored))))))
+(define (users-page-activate-item page item)
+ (let ((menu (page-datum page 'menu)))
+ (match item
+ (('menu-item-activated account)
+ (if account
+ (page-enter (make-user-edit-page page "Edit User" account)))
+ 'handled)
+
+ ('add
+ (let* ((next (make-user-edit-page page "Add New User" #f)))
+ (page-enter next)
+ 'handled))
+ ('continue
+ (page-leave)
+ 'handled)
+ ('delete
+ (set! users (remove (lambda (user)
+ (equal? user (menu-get-current-item menu)))
+ users))
+ (page-set-initialised! page #f)
+ 'handled)
+ (_
+ 'ignored))))
(define (users-page-refresh page)
(when (not (page-initialised? page))
diff --git a/gnu/system/installer/wireless.scm
b/gnu/system/installer/wireless.scm
index bae9291..c9fa53c 100644
--- a/gnu/system/installer/wireless.scm
+++ b/gnu/system/installer/wireless.scm
@@ -42,7 +42,7 @@
title
wireless-page-refresh
0
- #:activator wireless-page-activate-selected-item)))
+ #:activator wireless-page-activate-item)))
(page-set-datum! page 'ifce interface)
page))
@@ -50,32 +50,28 @@
(define my-buttons `((cancel ,(M_ "Canc_el") #t)))
-(define (wireless-page-activate-selected-item page)
- (let ((nav (page-datum page 'navigation))
- (menu (page-datum page 'menu))
- (test-window (page-datum page 'test-window)))
-
- (cond
- ((menu-active menu)
- (let ((ap (menu-get-current-item menu))
- (ifce (page-datum page 'ifce)))
- (if (assq-ref ap 'encryption)
- (let ((next (make-passphrase-page
- page
- (M_ "Passphrase entry")
- ifce
- ap)))
- (page-enter next))
- (begin
- (and (zero? (system* "ip" "link" "set" ifce "up"))
- (zero? (system* "iw" "dev" ifce "connect" (assq-ref ap
'essid)))
- (dhclient ifce))
- (page-leave)))))
- (else
- (match (buttons-selected-symbol nav)
- ('cancel
- (page-leave)
- 'handled))))))
+(define (wireless-page-activate-item page item)
+ (match item
+ (('menu-item-activated ap)
+ (let ((ifce (page-datum page 'ifce)))
+ (if (assq-ref ap 'encryption)
+ (let ((next (make-passphrase-page
+ page
+ (M_ "Passphrase entry")
+ ifce
+ ap)))
+ (page-enter next))
+ (begin
+ (and (zero? (system* "ip" "link" "set" ifce "up"))
+ (zero? (system* "iw" "dev" ifce "connect" (assq-ref ap
'essid)))
+ (dhclient ifce))
+ (page-leave))))
+ 'handled)
+ ('cancel
+ (page-leave)
+ 'handled)
+ (_
+ 'ignored)))
(define (wireless-page-refresh page)
(when (not (page-initialised? page))
diff --git a/gurses/menu.scm b/gurses/menu.scm
index 42418bf..912829a 100644
--- a/gurses/menu.scm
+++ b/gurses/menu.scm
@@ -186,8 +186,8 @@ active."
(menu-up menu)
'handled)
(else
- 'ignored))
- 'ignored))
+ #f))
+ #f))
(define (std-menu-mouse-handler menu device-id g-x g-y z button-state)
(if (logtest BUTTON1_CLICKED button-state)
@@ -202,6 +202,6 @@ active."
(begin
(menu-set-current-item! menu selected-item-index)
(menu-redraw menu)
- 'activated))))
- (_ 'ignored)))
- 'ignored))
+ (list 'menu-item-activated (menu-get-current-item menu))))))
+ (_ #f)))
+ #f))