01/01: installer: Allow user to focus config-window.

[Danny Milosavljevic]

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

commit 9119891ec2c7c02a5503fc93f325ef1ce8681093
Author: Danny Milosavljevic <address@hidden>
Date:   Mon Jul 10 02:47:36 2017 +0200

    installer: Allow user to focus config-window.
    
    * gnu/system/installer/page.scm (page-focused-widget): Handle config-window.
    (page-set-focused-widget): Handle config-window.
    (page-focus-widget-relative): Handle config-window.
    (make-page): Default config-window-focused to #f.
    * gnu/system/installer/configure.scm (configure-page-init):
    Focus config-window by default.
    * gnu/system/installer/install.scm (install-page-init):
    Focus config-window by default.
---
 gnu/system/installer/configure.scm |  3 ++-
 gnu/system/installer/install.scm   |  4 ++--
 gnu/system/installer/page.scm      | 24 ++++++++++++++++++++++--
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/gnu/system/installer/configure.scm 
b/gnu/system/installer/configure.scm
index 19c241a..3fd08e2 100644
--- a/gnu/system/installer/configure.scm
+++ b/gnu/system/installer/configure.scm
@@ -223,4 +223,5 @@
     (page-set-datum! p 'navigation buttons)
     (page-set-datum! p 'text-window text-window)
     (page-set-datum! p 'config-window config-window)
-    (buttons-post buttons bwin)))
+    (buttons-post buttons bwin)
+    (page-set-focused-widget p (inner config-window))))
diff --git a/gnu/system/installer/install.scm b/gnu/system/installer/install.scm
index 765b283..d6ff910 100644
--- a/gnu/system/installer/install.scm
+++ b/gnu/system/installer/install.scm
@@ -181,5 +181,5 @@
     (page-set-datum! p 'navigation buttons)
     (page-set-datum! p 'config-window (inner config-window))
     (page-set-datum! p 'config-window-port (open-output-string))
-    (buttons-post buttons bwin)))
-
+    (buttons-post buttons bwin)
+    (page-set-focused-widget p (inner config-window))))
diff --git a/gnu/system/installer/page.scm b/gnu/system/installer/page.scm
index 1666dc2..f8842ad 100644
--- a/gnu/system/installer/page.scm
+++ b/gnu/system/installer/page.scm
@@ -35,7 +35,8 @@
   #:export (page-default-key-handler)
   #:export (page-default-mouse-handler)
   #:export (page-getch)
-  #:export (page-focused-window)
+  #:export (page-focused-widget)
+  #:export (page-set-focused-widget)
   #:export (refresh-screen)
 
   #:use-module (gurses buttons)
@@ -46,6 +47,7 @@
   #:use-module (gnu system installer utils)
   #:use-module (gnu system installer levelled-stack)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
   #:use-module (ice-9 match))
 
 (define-record-type <page>
@@ -67,7 +69,9 @@
 (define (page-focused-widget page)
   (let* ((menu (page-datum page 'menu))
          (nav  (page-datum page 'navigation))
-         (form (page-datum page 'form)))
+         (form (page-datum page 'form))
+         (config-window (and=> (page-datum page 'config-window)
+                               (cut inner <>))))
     (cond
      ((and menu (menu-active menu))
       menu)
@@ -75,6 +79,8 @@
       form)
      ((and nav (buttons-selected-symbol nav))
       nav)
+     ((and config-window (page-datum page 'config-window-focused))
+      config-window)
      (else
       #f))))
 
@@ -82,12 +88,19 @@
   (let* ((menu (page-datum page 'menu))
          (nav  (page-datum page 'navigation))
          (form (page-datum page 'form))
+         (config-window (and=> (page-datum page 'config-window)
+                               (cut inner <>)))
          (widgets (filter (lambda (entry)
                             (match entry
                              ((widget focused? set-focused!)
                                widget)))
                           (list (list menu menu-active menu-set-active!)
                                 (list form form-enabled? form-set-enabled!)
+                                (list config-window
+                                      (lambda (w)
+                                        (page-datum page 
'config-window-focused))
+                                      (lambda (w value)
+                                        (page-set-datum! page 
'config-window-focused value)))
                                 (list nav buttons-selected-symbol (lambda 
(buttons value)
                                                                     
(buttons-select buttons
                                                                       (if value
@@ -113,12 +126,18 @@
   (let* ((menu (page-datum page 'menu))
          (nav  (page-datum page 'navigation))
          (form (page-datum page 'form))
+         (config-window (and=> (page-datum page 'config-window) (cut inner 
<>)))
          (widgets (filter (lambda (entry)
                             (match entry
                              ((widget focused? set-focused!)
                                widget)))
                           (list (list menu menu-active menu-set-active!)
                                 (list form form-enabled? form-set-enabled!)
+                                (list config-window
+                                      (lambda (w)
+                                        (page-datum page 
'config-window-focused))
+                                      (lambda (w value)
+                                        (page-set-datum! page 
'config-window-focused value)))
                                 (list nav buttons-selected-symbol
                                       (lambda (buttons value)
                                         (let ((index (buttons-selected 
buttons)))
@@ -285,6 +304,7 @@ If a form is used it's assumed that the menu is not used 
and vice versa."
          (xsurface  (inner frame)))
     (let* ((result (make-page' xsurface title #f refresh cursor-visibility 
key-handler mouse-handler '())))
       (page-set-wwin! result frame)
+      (page-set-datum! result 'config-window-focused #f)
       (if activator
         (page-set-datum! result 'activator activator))
       result)))