installer: Ask for confirmation before formatting partitions.

* gnu/installer/newt/page.scm (run-confirmation-page): New procedure.
* gnu/installer/newt/partition.scm (draw-formatting-page): Call it.

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")))