01/01: installer: Add scrollbar to config-window.

[Danny Milosavljevic]

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

commit b5dbd66681a0391a06d65f20b1e58006d91ade11
Author: Danny Milosavljevic <address@hidden>
Date:   Mon Jul 10 14:46:27 2017 +0200

    installer: Add scrollbar to config-window.
    
    * gurses/colors.scm (colors): Add "scrollbar" color.
    * gnu/system/installer/utils.scm (boxed-window-decoration-refresh): New
    keyword parameter #:scrollbar-fraction.  Draw scrollbar.
    * gnu/system/installer/page.scm (page-refresh): Use it.
---
 gnu/system/installer/page.scm  |  3 ++-
 gnu/system/installer/utils.scm | 17 ++++++++++++++++-
 gurses/colors.scm              |  3 ++-
 3 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/gnu/system/installer/page.scm b/gnu/system/installer/page.scm
index f8842ad..ecfd0c5 100644
--- a/gnu/system/installer/page.scm
+++ b/gnu/system/installer/page.scm
@@ -354,7 +354,8 @@ If a form is used it's assumed that the menu is not used 
and vice versa."
           (begin
             (boxed-window-decoration-refresh config-window
                                              (or config-window-title
-                                                 "Output"))
+                                                 "Output")
+                                             #:scrollbar-fraction 0.3)
             (erase (inner config-window))
             ; TODO scrolling...
             (if config-window-port
diff --git a/gnu/system/installer/utils.scm b/gnu/system/installer/utils.scm
index afac3a3..7640928 100644
--- a/gnu/system/installer/utils.scm
+++ b/gnu/system/installer/utils.scm
@@ -266,7 +266,7 @@ Ignore blank lines."
          (error "~s is not a window" outside))
      outside)))
 
-(define* (boxed-window-decoration-refresh pr title)
+(define* (boxed-window-decoration-refresh pr title #:key (scrollbar-fraction 
#f))
   (let ((win (outer pr)))
     ;(erase win)
     (select-color! win 'normal)
@@ -279,6 +279,21 @@ Ignore blank lines."
         ;(hline win (acs-hline) (- (getmaxx win) 2))
         (select-color! win 'livery-title)
         (addstr win title #:y 0 #:x (round (/ (- (getmaxx win) (string-length 
title)) 2)))))
+    (select-color! win 'scrollbar)
+    (if scrollbar-fraction
+      (let ((scrollbar-x (- (getmaxx win) 1))
+            (outer-maxy (getmaxy win)))
+        (vline win
+               (acs-ckboard)
+               (- outer-maxy 4)
+               #:y 2 #:x scrollbar-x)
+        (addch win
+               (inverse (acs-uarrow))
+               #:y 1 #:x scrollbar-x)
+        (addch win
+              (inverse (acs-darrow))
+              #:y (- outer-maxy 2)
+              #:x scrollbar-x)))
     (select-color! win 'normal)))
 
 (define* (make-boxed-window orig height width starty startx #:key (title #f))
diff --git a/gurses/colors.scm b/gurses/colors.scm
index c6c1d87..c1fc16e 100644
--- a/gurses/colors.scm
+++ b/gurses/colors.scm
@@ -13,7 +13,8 @@
         (list 'selected-menu-item COLOR_GREEN COLOR_BLUE)
         (list 'menu-item COLOR_BLACK COLOR_WHITE)
         (list 'explanation COLOR_BLACK COLOR_WHITE)
-        (list 'form-field COLOR_BLUE COLOR_WHITE)))
+        (list 'form-field COLOR_BLUE COLOR_WHITE)
+        (list 'scrollbar COLOR_BLUE COLOR_WHITE)))
 
 (define-public (color-index-by-symbol color)
   (let loop ((i 0) (p colors))