aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-03-27 09:50:24 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-27 11:54:05 +0100
commitc73e554c3fe609ee2d66628f7f09cf7fa6c8d4a6 (patch)
treecfb554b9ea2ff9f8837e38d70f8eacf3b372cca1 /gnu/installer
parent50247be5f4633a4c3446cddbd3515d027853ec0d (diff)
downloadguix-c73e554c3fe609ee2d66628f7f09cf7fa6c8d4a6.tar
guix-c73e554c3fe609ee2d66628f7f09cf7fa6c8d4a6.tar.gz
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.
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/newt/page.scm38
-rw-r--r--gnu/installer/newt/partition.scm8
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")))