;;; 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.
;;;
(define (run-scheme-page)
"Run a page asking the user for a partitioning scheme."
(let* ((items
- '((root . "Everything is one partition")
- (root-home . "Separate /home partition")))
+ `((root . ,(G_ "Everything is one partition"))
+ (root-home . ,(G_ "Separate /home partition"))))
(result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning scheme.")
#:title (G_ "Partition scheme")
#:listbox-items items
#:listbox-item->text cdr
+ #:listbox-height 4
+ #:sort-listbox-items? #f ;keep the 'root' option first
#:button-text (G_ "Exit")
#:button-callback-procedure button-exit-action)))
(car result)))
-(define (draw-formating-page)
- "Draw a page to indicate partitions are being formated."
+(define (draw-formatting-page)
+ "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 formating is in progress, please wait."))
+ (format #f (G_ "Partition formatting is in progress, please wait."))
(G_ "Preparing partitions")))
(define (run-device-page devices)
#:title (G_ "Disk")
#:listbox-items (device-items)
#:listbox-item->text cdr
+ #:listbox-height 10
#:button-text (G_ "Exit")
#:button-callback-procedure button-exit-action))
(device (car result)))
(run-listbox-selection-page
#:info-text (G_ "Please select the file-system type for this partition.")
#:title (G_ "File-system type")
- #:listbox-items '(ext4 btrfs fat32 swap)
+ #:listbox-items '(ext4 btrfs fat16 fat32 swap)
#:listbox-item->text user-fs-type-name
#:sort-listbox-items? #f
#:button-text (G_ "Exit")
(run-input-page
(format #f (G_ "Please enter the password for the \
encryption of partition ~a (label: ~a).") file-name crypt-label)
- (G_ "Password required"))))
+ (G_ "Password required")
+ #:input-hide-checkbox? #t)))
(password-confirm-page
(lambda ()
(run-input-page
(format #f (G_ "Please confirm the password for the \
encryption of partition ~a (label: ~a).") file-name crypt-label)
- (G_ "Password confirmation required")))))
+ (G_ "Password confirmation required")
+ #:input-hide-checkbox? #t))))
(if crypt-label
(let loop ()
(let ((password (password-page))
(G_ "Encryption label")))))
(user-partition
(inherit target-user-partition)
- (need-formating? #t)
+ (need-formatting? #t)
(crypt-label new-label))))
- ((need-formating?)
+ ((need-formatting?)
(user-partition
(inherit target-user-partition)
- (need-formating?
- (not (user-partition-need-formating?
+ (need-formatting?
+ (not (user-partition-need-formatting?
target-user-partition)))))
((size)
(let* ((old-size (user-partition-size target-user-partition))
(and new-partition
(user-partition
(inherit new-user-partition)
- (need-formating? #t)
+ (need-formatting? #t)
(file-name (partition-get-path new-partition))
(disk-file-name (device-path device))
(parted-object new-partition))))
(run-listbox-selection-page
#:info-text
(if creation?
- (G_ (format #f "Creating ~a partition starting at ~a of ~a."
- type-str start file-name))
- (G_ (format #f "You are currently editing partition ~a."
- number-str)))
+ (format #f (G_ "Creating ~a partition starting at ~a of ~a.")
+ type-str start file-name)
+ (format #f (G_ "You are currently editing partition ~a.")
+ number-str))
#:title (if creation?
(G_ "Partition creation")
(G_ "Partition edit"))
#:title (if guided?
(G_ "Guided partitioning")
(G_ "Manual partitioning"))
- #:info-textbox-width 70
+ #:info-textbox-width 76 ;we need a lot of room for INFO-TEXT
+ #:listbox-height 12
#:listbox-items (disk-items)
#:listbox-item->text cdr
#:sort-listbox-items? #f
"Run a page asking the user for a partitioning method."
(define (run-page devices)
(let* ((items
- '((entire . "Guided - using the entire disk")
- (entire-encrypted . "Guided - using the entire disk with encryption")
- (manual . "Manual")))
+ `((entire . ,(G_ "Guided - using the entire disk"))
+ (entire-encrypted . ,(G_ "Guided - using the entire disk with encryption"))
+ (manual . ,(G_ "Manual"))))
(result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning method.")
#:title (G_ "Partitioning method")
+ #:listbox-height (+ (length items) 2)
#:listbox-items items
#:listbox-item->text cdr
+ #:sort-listbox-items? #f
#:button-text (G_ "Exit")
#:button-callback-procedure button-exit-action))
(method (car result)))
(disk-commit disk)
disk)))
(scheme (symbol-append method '- (run-scheme-page)))
- (user-partitions (append
- (auto-partition disk #:scheme scheme)
- (create-special-user-partitions
- (disk-partitions disk)))))
+ (user-partitions (auto-partition! disk #:scheme scheme)))
(run-disk-page (list disk) user-partitions
#:guided? #t)))
((eq? method 'manual)
- (let* ((disks (map disk-new devices))
+ (let* ((disks (filter-map disk-new devices))
(user-partitions (append-map
create-special-user-partitions
(map disk-partitions disks)))
(user-partitions (run-page non-install-devices))
(user-partitions-with-pass (prompt-luks-passwords
user-partitions))
- (form (draw-formating-page)))
- ;; Make sure the disks are not in use before proceeding to formating.
+ (form (draw-formatting-page)))
+ ;; Make sure the disks are not in use before proceeding to formatting.
(free-parted non-install-devices)
(format-user-partitions user-partitions-with-pass)
(destroy-form-and-pop form)
HCoop / jackhill / guix / guix.git / blobdiff