diff options
Diffstat (limited to 'gnu/installer/newt')
| -rw-r--r-- | gnu/installer/newt/page.scm | 38 | ||||
| -rw-r--r-- | gnu/installer/newt/partition.scm | 8 | 
2 files changed, 45 insertions, 1 deletions
| diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 23fbfcce76..8b3fd488e9 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.  ;;; @@ -29,6 +30,7 @@              draw-connecting-page              run-input-page              run-error-page +            run-confirmation-page              run-listbox-selection-page              run-scale-page              run-checkbox-tree-page @@ -141,6 +143,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 diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index d4c91edc66..373aedd24c 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.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.  ;;; @@ -53,7 +54,12 @@      (car result)))  (define (draw-formatting-page) -  "Draw a page to indicate partitions are being formated." +  "Draw a page asking for confirmation, and then indicating that partitions +are being formatted." +  (run-confirmation-page (G_ "We are about to format your hard disk.  All \ +its data will be lost.  Do you wish to continue?") +                         (G_ "Format disk?") +                         #:exit-button-procedure button-exit-action)    (draw-info-page     (format #f (G_ "Partition formatting is in progress, please wait."))     (G_ "Preparing partitions"))) | 
