aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer/newt/page.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer/newt/page.scm')
-rw-r--r--gnu/installer/newt/page.scm76
1 files changed, 63 insertions, 13 deletions
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 23fbfcce76..3173d54737 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,6 +21,7 @@
#:use-module (gnu installer utils)
#:use-module (gnu installer newt utils)
#:use-module (guix i18n)
+ #:use-module (ice-9 i18n)
#:use-module (ice-9 match)
#:use-module (ice-9 receive)
#:use-module (srfi srfi-1)
@@ -29,6 +31,7 @@
draw-connecting-page
run-input-page
run-error-page
+ run-confirmation-page
run-listbox-selection-page
run-scale-page
run-checkbox-tree-page
@@ -72,17 +75,20 @@ this page to TITLE."
#:key
(allow-empty-input? #f)
(default-text #f)
- (input-field-width 40))
+ (input-field-width 40)
+ (input-flags 0))
"Run a page to prompt user for an input. The given TEXT will be displayed
above the input field. The page title is set to TITLE. Unless
allow-empty-input? is set to #t, an error page will be displayed if the user
-enters an empty input."
+enters an empty input. INPUT-FLAGS is a bitwise-or'd set of flags for the
+input box, such as FLAG-PASSWORD."
(let* ((text-box
(make-reflowed-textbox -1 -1 text
input-field-width
#:flags FLAG-BORDER))
(grid (make-grid 1 3))
- (input-entry (make-entry -1 -1 20))
+ (input-entry (make-entry -1 -1 20
+ #:flags input-flags))
(ok-button (make-button -1 -1 (G_ "OK")))
(form (make-form)))
@@ -141,6 +147,42 @@ of the page is set to TITLE."
(newt-set-color COLORSET-ROOT "white" "blue")
(destroy-form-and-pop form)))
+(define* (run-confirmation-page text title
+ #:key (exit-button-procedure (const #f)))
+ "Run a page to inform the user of an error. The page contains the given TEXT
+to explain the error and an \"OK\" button to acknowledge the error. The title
+of the page is set to TITLE."
+ (let* ((text-box
+ (make-reflowed-textbox -1 -1 text 40
+ #:flags FLAG-BORDER))
+ (ok-button (make-button -1 -1 (G_ "Continue")))
+ (exit-button (make-button -1 -1 (G_ "Exit")))
+ (grid (vertically-stacked-grid
+ GRID-ELEMENT-COMPONENT text-box
+ GRID-ELEMENT-SUBGRID
+ (horizontal-stacked-grid
+ GRID-ELEMENT-COMPONENT ok-button
+ GRID-ELEMENT-COMPONENT exit-button)))
+ (form (make-form)))
+
+ (add-form-to-grid grid form #t)
+ (make-wrapped-grid-window grid title)
+
+ (receive (exit-reason argument)
+ (run-form form)
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (case exit-reason
+ ((exit-component)
+ (cond
+ ((components=? argument ok-button)
+ #t)
+ ((components=? argument exit-button)
+ (exit-button-procedure))))))
+ (lambda ()
+ (destroy-form-and-pop form))))))
+
(define* (run-listbox-selection-page #:key
info-text
title
@@ -185,7 +227,7 @@ be selected (using the <SPACE> key). It that case, a list containing the
selected items will be returned.
If SORT-LISTBOX-ITEMS? is set to #t, the listbox items are sorted using
-'string<=' procedure (after being converted to text).
+'string-locale<?' procedure (after being converted to text).
If ALLOW-DELETE? is #t, the form will return if the <DELETE> key is pressed,
otherwise nothing will happen.
@@ -211,7 +253,7 @@ ITEM was inserted into LISTBOX."
items))
(define (sort-listbox-items listbox-items)
- "Return LISTBOX-ITEMS sorted using the 'string<=' procedure on the text
+ "Return LISTBOX-ITEMS sorted using the 'string-locale<?' procedure on the text
corresponding to each item in the list."
(let* ((items (map (lambda (item)
(cons item (listbox-item->text item)))
@@ -220,7 +262,7 @@ corresponding to each item in the list."
(sort items (lambda (a b)
(let ((text-a (cdr a))
(text-b (cdr b)))
- (string<= text-a text-b))))))
+ (string-locale<? text-a text-b))))))
(map car sorted-items)))
;; Store the last selected listbox item's key.
@@ -395,10 +437,14 @@ error is raised if the MAX-SCALE-UPDATE limit is reached."
(lambda ()
(destroy-form-and-pop form)))))
+(define %none-selected
+ (circular-list #f))
+
(define* (run-checkbox-tree-page #:key
info-text
title
items
+ (selection %none-selected)
item->text
(info-textbox-width 50)
(checkbox-tree-height 10)
@@ -411,7 +457,8 @@ a checkbox list. The page contains vertically stacked from the top to the
bottom, an informative text set to INFO-TEXT, the checkbox list and two
buttons, 'Ok' and 'Exit'. The page title's is set to TITLE. ITEMS are
converted to text using ITEM->TEXT before being displayed in the checkbox
-list.
+list. SELECTION is a list of Booleans of the same length as ITEMS that
+specifies which items are initially checked.
INFO-TEXTBOX-WIDTH is the width of the textbox where INFO-TEXT will be
displayed. CHECKBOX-TREE-HEIGHT is the height of the checkbox list.
@@ -423,12 +470,15 @@ pressed.
This procedure returns the list of checked items in the checkbox list among
ITEMS when 'Ok' is pressed."
(define (fill-checkbox-tree checkbox-tree items)
- (map
- (lambda (item)
- (let* ((item-text (item->text item))
- (key (add-entry-to-checkboxtree checkbox-tree item-text 0)))
- (cons key item)))
- items))
+ (map (lambda (item selected?)
+ (let* ((item-text (item->text item))
+ (key (add-entry-to-checkboxtree checkbox-tree item-text
+ (if selected?
+ FLAG-SELECTED
+ 0))))
+ (cons key item)))
+ items
+ selection))
(let* ((checkbox-tree
(make-checkboxtree -1 -1