summary refs log tree commit diff
path: root/gnu/installer/newt/partition.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer/newt/partition.scm')
-rw-r--r--gnu/installer/newt/partition.scm18
1 files changed, 16 insertions, 2 deletions
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 2adb4922b4..37656696c1 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -92,17 +92,31 @@ disk.  The installation device as well as the small devices are filtered.")
          (device (car result)))
     device))
 
+(define (run-label-confirmation-page callback)
+  (lambda (item)
+    (match (current-clients)
+      (()
+       (and (run-confirmation-page
+             (format #f (G_ "This will create a new ~a partition table, \
+all data on disk will be lost, are you sure you want to proceed?") item)
+             (G_ "Format disk?")
+             #:exit-button-procedure callback)
+            item))
+      (_ item))))
+
 (define (run-label-page button-text button-callback)
   "Run a page asking the user to select a partition table label."
   ;; Force the GPT label if UEFI is supported.
   (if (efi-installation?)
-      "gpt"
+      ((run-label-confirmation-page button-callback) "gpt")
       (run-listbox-selection-page
        #:info-text (G_ "Select a new partition table type. \
 Be careful, all data on the disk will be lost.")
        #:title (G_ "Partition table")
        #:listbox-items '("msdos" "gpt")
        #:listbox-item->text identity
+       #:listbox-callback-procedure
+       (run-label-confirmation-page button-callback)
        #:button-text button-text
        #:button-callback-procedure button-callback)))