06/06: installer: Also allow the clicking of buttons.

[Danny Milosavljevic]

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

commit f327663d7cb7bc4167b225659b6c7e33e2d30028
Author: Danny Milosavljevic <address@hidden>
Date:   Tue Jul 4 19:36:51 2017 +0200

    installer: Also allow the clicking of buttons.
    
    * gurses/buttons.scm (buttons-mouse-handler): New variable.  Export it.
    * gnu/system/installer/disks.scm (disk-page-activate-focused-item): Modify.
    (disk-page-mouse-handler): Modify.
---
 gnu/system/installer/disks.scm | 31 +++++++++++++++++++++++--------
 gurses/buttons.scm             | 21 +++++++++++++++++++--
 2 files changed, 42 insertions(+), 10 deletions(-)

diff --git a/gnu/system/installer/disks.scm b/gnu/system/installer/disks.scm
index f56ece0..a7c3fa1 100644
--- a/gnu/system/installer/disks.scm
+++ b/gnu/system/installer/disks.scm
@@ -59,15 +59,30 @@
       (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")))
+  (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-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)))
+         (status (std-menu-mouse-handler menu device-id x y z button-state))
+         (buttons (page-datum page 'navigation))
+         (status (if (eq? status 'ignored)
+                     (let ((button-status (buttons-mouse-handler buttons
+                                                                 device-id
+                                                                 x y z
+                                                                 
button-state)))
+                       (if (eq? button-status 'activated)
+                         (menu-set-active! menu #f))
+                       button-status)
+                     status)))
     (if (eq? status 'activated)
       (disk-page-activate-focused-item page))
     status))
@@ -84,8 +99,8 @@
      ((eq? ch #\tab)
       (cond
        ((menu-active menu)
-         (menu-set-active! menu #f)
-         (buttons-select nav 0))
+        (menu-set-active! menu #f)
+        (buttons-select nav 0))
 
        ((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
        (menu-set-active! menu #t)
diff --git a/gurses/buttons.scm b/gurses/buttons.scm
index 76b637a..d44a684 100644
--- a/gurses/buttons.scm
+++ b/gurses/buttons.scm
@@ -28,9 +28,11 @@
   #:export (buttons-fetch-by-key)
   #:export (buttons-n-buttons)
   #:export (buttons-key-matches-symbol?)
+  #:export (buttons-mouse-handler)
 
   #:use-module (ncurses curses)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9))
 
 (define-record-type <buttons>
@@ -163,6 +165,21 @@
               (and=> (buttons-get-current-selection nav)
                      (lambda (x) (eq? x symbol)))))
   #f))
-               
-
 
+(define (buttons-mouse-handler buttons device-id g-x g-y z button-state)
+  (if (logtest BUTTON1_CLICKED button-state)
+      (let* ((arry (buttons-array buttons))
+             (len (array-length arry)))
+        (let loop ((i 0))
+          (if (< i len)
+              (match (array-ref arry i)
+               ((ch win sym)
+                (match (mouse-trafo win g-y g-x #f)
+                 ((y x)
+                  (buttons-select buttons i)
+                  'activated)
+                  (_ (if (< i len)
+                         (loop (1+ i))
+                         'ignored)))))
+              'ignored)))
+      'ignored))