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.master
parent
50247be5f4
commit
c73e554c3f
|
@ -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
|
||||
|
|
|
@ -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")))
|
||||
|
|
Reference in New Issue