03/06: installer: Factor out item activation and use it for mouse, too.

[Danny Milosavljevic]

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

commit c2b6fb04f2a803011c77f3a9b2d18fe097ade824
Author: Danny Milosavljevic <address@hidden>
Date:   Tue Jul 4 18:40:06 2017 +0200

    installer: Factor out item activation and use it for mouse, too.
    
    * gnu/system/installer/guixsd-installer.scm 
(main-page-activate-focused-item):
    New variable.
    (main-page-key-handler): Use it here.
    (main-page-mouse-handler): Use it here.
    * gnu/system/installer/disks.scm (disk-page-activate-focused-item):
    New variable.
    (disk-page-key-handler): Use it here.
    (disk-page-mouse-handler): Use it here.
    * gnu/system/installer/filesystems.scm 
(filesystem-page-activate-focused-item):
    New variable.
    (filesystem-page-key-handler): Use it here.
    (filesystem-page-mouse-handler): Use it here.
    * gnu/system/installer/key-map.scm (key-map-page-activate-focused-item):
    New variable.
    (key-map-page-key-handler): Use it here.
    (key-map-page-mouse-handler): Use it here.
    * gnu/system/installer/locale.scm (locale-page-activate-focused-item):
    New variable.
    (locale-page-key-handler): Use it here.
    (locale-page-mouse-handler): Use it here.
    * gnu/system/installer/role.scm (role-page-activate-focused-item):
    New variable.
    (role-page-key-handler): Use it here.
    (role-page-mouse-handler): Use it here.
    * gnu/system/installer/time-zone.scm (time-zone-page-activate-focused-item):
    New variable.
    (time-zone-page-key-handler): Use it here.
    (time-zone-page-mouse-handler): Use it here.
---
 gnu/system/installer/disks.scm            | 21 ++++++++-----
 gnu/system/installer/filesystems.scm      | 34 ++++++++++++--------
 gnu/system/installer/guixsd-installer.scm | 23 ++++++++------
 gnu/system/installer/key-map.scm          | 37 +++++++++++++---------
 gnu/system/installer/locale.scm           | 18 ++++++++---
 gnu/system/installer/role.scm             | 18 ++++++++---
 gnu/system/installer/time-zone.scm        | 52 ++++++++++++++++++-------------
 7 files changed, 126 insertions(+), 77 deletions(-)

diff --git a/gnu/system/installer/disks.scm b/gnu/system/installer/disks.scm
index a7164b7..61c1f65 100644
--- a/gnu/system/installer/disks.scm
+++ b/gnu/system/installer/disks.scm
@@ -58,8 +58,19 @@
       (menu-redraw menu)
       (menu-refresh menu)))
 
+(define (disk-page-activate-focused-item page)
+  (let* ((menu (page-datum page 'menu))
+         (i (menu-current-item menu)))
+    (endwin)
+      (system* "cfdisk" (disk-name (list-ref (menu-items menu) i)))
+      (system* "partprobe")))
+
 (define (disk-page-mouse-handler page device-id x y z button-state)
-  'ignored)
+  (let* ((menu (page-datum page 'menu))
+         (status (std-menu-mouse-handler menu device-id x y z button-state)))
+    (if (eq? status 'activated)
+      (disk-page-activate-focused-item page))
+    status))
 
 (define (disk-page-key-handler page ch)
   (let ((menu (page-datum page 'menu))
@@ -92,12 +103,8 @@
       (menu-set-active! menu #t))
 
      ((and (eq? ch #\newline)
-          (menu-active menu))
-      (let ((i (menu-current-item menu)))
-       (endwin)
-       (system* "cfdisk"
-                (disk-name (list-ref (menu-items menu) i)))
-        (system* "partprobe")))
+           (menu-active menu))
+      (disk-page-activate-focused-item page))
 
      ((buttons-key-matches-symbol? nav ch 'continue)
       (page-leave)))
diff --git a/gnu/system/installer/filesystems.scm 
b/gnu/system/installer/filesystems.scm
index b8fde7a..7568f17 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -172,8 +172,27 @@
        (error (format #f "~s is not a partition" p)))
      p)))
 
+(define (filesystem-page-activate-focused-item page)
+  (let* ((menu (page-datum page 'menu))
+         (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
+                           mount-point-page-mouse-handler)))
+
+    (page-set-datum! next 'device name)
+    (page-enter next)))
+
 (define (filesystem-page-mouse-handler page device-id x y z button-state)
-  'ignored)
+  (let* ((menu (page-datum page 'menu))
+         (status (std-menu-mouse-handler menu device-id x y z button-state)))
+    (if (eq? status 'activated)
+      (filesystem-page-activate-focused-item page))
+    status))
 
 (define (filesystem-page-key-handler page ch)
   (let* ((menu (page-datum page 'menu))
@@ -205,18 +224,7 @@
                  (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
-                                          mount-point-page-mouse-handler)))
-
-                   (page-set-datum! next 'device name)
-                   (page-enter next)))
+                 (filesystem-page-activate-focused-item page))
 
                 ((buttons-key-matches-symbol? nav ch 'cancel)
                  (page-leave)
diff --git a/gnu/system/installer/guixsd-installer.scm 
b/gnu/system/installer/guixsd-installer.scm
index 599407d..a8503b0 100644
--- a/gnu/system/installer/guixsd-installer.scm
+++ b/gnu/system/installer/guixsd-installer.scm
@@ -205,23 +205,26 @@
            (do-task task-name page))))
    task-name-list))
 
+(define (main-page-activate-focused-item page)
+  (let* ((main-menu (page-datum page 'menu))
+         (item (menu-get-current-item main-menu)))
+    (do-task (car item) page)
+    (page-uniquify)
+    ((page-refresh (car stack)) (car stack))))
+
 (define (main-page-mouse-handler page device-id x y z button-state)
-  (let ((main-menu (page-datum page 'menu)))
-    (if (eq? 'activated (std-menu-mouse-handler main-menu device-id x y z 
button-state))
-      (let ((item (menu-get-current-item main-menu)))
-        (do-task (car item) page)
-        (page-uniquify)
-        ((page-refresh (car stack)) (car stack))))))
+  (let* ((main-menu (page-datum page 'menu))
+         (status (std-menu-mouse-handler main-menu device-id x y z 
button-state)))
+    (if (eq? 'activated status)
+      (main-page-activate-focused-item page))
+    status))
 
 (define (main-page-key-handler page ch)
   (let ((main-menu (page-datum page 'menu)))
     (std-menu-key-handler main-menu ch)
     (cond
      ((eq? ch #\newline)
-      (let ((item (menu-get-current-item main-menu)))
-        (do-task (car item) page)
-        (page-uniquify)
-        ((page-refresh (car stack)) (car stack)))))))
+      (main-page-activate-focused-item page)))))
 
 (define (main-page-init page)
   (let* ((frame (make-boxed-window (page-surface page) (lines) (cols) 0 0
diff --git a/gnu/system/installer/key-map.scm b/gnu/system/installer/key-map.scm
index ee64d95..30928d3 100644
--- a/gnu/system/installer/key-map.scm
+++ b/gnu/system/installer/key-map.scm
@@ -42,14 +42,32 @@
 
 (define my-buttons `((cancel  ,(M_ "Canc_el") #t)))
 
+(define (key-map-page-activate-focused-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)))
+    (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!
+        (page-enter p))
+      (begin
+        (system* "loadkeys" i)
+        (set! key-map i)
+        (page-leave)
+        #f))))
+
 (define (key-map-page-mouse-handler page device-id x y z button-state)
-  'ignored)
+  (let* ((menu (page-datum page 'menu))
+         (status (std-menu-mouse-handler menu device-id x y z button-state)))
+    (if (eq? status 'activated)
+      (key-map-page-activate-focused-item page))
+    status))
 
 (define (key-map-page-key-handler page ch)
   (let ((nav  (page-datum page 'navigation))
        (menu (page-datum page 'menu))
        (directory (page-datum page 'directory)))
-
     (cond
      ((eq? ch #\tab)
       (cond
@@ -64,19 +82,8 @@
       (page-leave))
 
      ((and (eqv? ch #\newline)
-          (menu-active menu))
-      (let* ((i (menu-get-current-item menu))
-             (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!
-              (page-enter p))
-           (begin
-              (system* "loadkeys" i)
-              (set! key-map i)
-              (page-leave)
-              #f)))))
+           (menu-active menu))
+      (key-map-page-activate-focused-item page)))
     (std-menu-key-handler menu ch)
     #f))
 
diff --git a/gnu/system/installer/locale.scm b/gnu/system/installer/locale.scm
index 7ec384f..eb00dad 100644
--- a/gnu/system/installer/locale.scm
+++ b/gnu/system/installer/locale.scm
@@ -57,8 +57,18 @@
       (menu-redraw menu)
       (menu-refresh menu)))
 
+(define (locale-page-activate-focused-item page)
+  (let* ((menu (page-datum page 'menu))
+         (locale (menu-get-current-item menu)))
+    (setlocale LC_ALL (locale-definition-name locale))
+    (page-leave)))
+
 (define (locale-page-mouse-handler page device-id x y z button-state)
-  'ignored)
+  (let* ((menu (page-datum page 'menu))
+         (status (std-menu-mouse-handler menu device-id x y z button-state)))
+    (if (eq? status 'activated)
+      (locale-page-activate-focused-item page))
+    status))
 
 (define (locale-page-key-handler page ch)
   (let ((menu (page-datum page 'menu))
@@ -91,10 +101,8 @@
       (menu-set-active! menu #t))
 
      ((and (eq? ch #\newline)
-          (menu-active menu))
-      (let ((locale (menu-get-current-item menu)))
-        (setlocale LC_ALL (locale-definition-name locale))
-        (page-leave)))
+           (menu-active menu))
+      (locale-page-activate-focused-item page))
 
      ((buttons-key-matches-symbol? nav ch 'cancel)
       (page-leave)))
diff --git a/gnu/system/installer/role.scm b/gnu/system/installer/role.scm
index aa4fcda..9232b92 100644
--- a/gnu/system/installer/role.scm
+++ b/gnu/system/installer/role.scm
@@ -57,8 +57,17 @@
 
 (define my-buttons `((cancel ,(M_ "Canc_el") #t)))
 
-(define (role-page-mouse-handler device-id x y z button-state)
-  'ignored)
+(define (role-page-activate-focused-item page)
+  (let ((menu (page-datum page 'menu)))
+    (set! system-role (menu-get-current-item menu))
+    (page-leave)))
+
+(define (role-page-mouse-handler page device-id x y z button-state)
+  (let* ((menu (page-datum page 'menu))
+         (status (std-menu-mouse-handler menu device-id x y z button-state)))
+    (if (eq? status 'activated)
+      (role-page-activate-focused-item page))
+    status))
 
 (define (role-page-key-handler page ch)
   (let* ((menu (page-datum page 'menu))
@@ -90,9 +99,8 @@
 
 
      ((select-key? ch)
-      (set! system-role (menu-get-current-item menu))
-
-      (page-leave))
+      (if (menu-active menu)
+        (role-page-activate-focused-item page)))
 
      ((buttons-key-matches-symbol? nav ch 'cancel)
       (page-leave)
diff --git a/gnu/system/installer/time-zone.scm 
b/gnu/system/installer/time-zone.scm
index 7663711..d4313cb 100644
--- a/gnu/system/installer/time-zone.scm
+++ b/gnu/system/installer/time-zone.scm
@@ -42,8 +42,35 @@
 
 (define my-buttons `((cancel  ,(M_ "Canc_el") #t)))
 
+(define (time-zone-page-activate-focused-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))
+         (st (lstat new-dir)))
+    (if (and (file-exists? new-dir)
+             (eq? 'directory (stat:type st)))
+      (let ((p (make-tz-browser page new-dir)))
+        (page-set-datum! p 'stem
+           (if (page-datum page 'stem)
+             (string-append (page-datum page 'stem) "/" i)
+             i))
+        (page-pop)  ; Don't go back to the current page!
+        (page-enter p))
+      (begin
+        (set! time-zone
+          (if (page-datum page 'stem)
+            (string-append (page-datum page 'stem) "/" i)
+            i))
+        (page-leave)
+        #f))))
+
 (define (time-zone-page-mouse-handler page device-id x y z button-state)
-  'ignored)
+  (let* ((menu (page-datum page 'menu))
+         (status (std-menu-mouse-handler menu device-id x y z button-state)))
+    (if (eq? status 'activated)
+      (time-zone-page-activate-focused-item page))
+    status))
 
 (define (time-zone-page-key-handler page ch)
   (let* ((nav  (page-datum page 'navigation))
@@ -63,27 +90,8 @@
       'cancelled)
 
      ((and (eqv? ch #\newline)
-          (menu-active menu))
-      (let* ((i (menu-get-current-item menu))
-            (new-dir (string-append directory "/" i))
-            (st (lstat new-dir)))
-       (if (and (file-exists? new-dir)
-                (eq? 'directory (stat:type st)))
-           (let ((p (make-tz-browser page new-dir)))
-             (page-set-datum! p 'stem
-                              (if (page-datum page 'stem)
-                                  (string-append (page-datum page 'stem) "/" i)
-                                  i))
-              (page-pop)  ; Don't go back to the current page!
-              (page-enter p))
-           (begin
-             (set! time-zone
-               (if (page-datum page 'stem)
-                   (string-append (page-datum page 'stem) "/" i)
-                   i))
-             (page-leave)
-             #f)))
-      ))))
+           (menu-active menu))
+      (time-zone-page-activate-focused-item page)))))
   (std-menu-key-handler menu ch)
   result))