me
/
guix
Archived
1
0
Fork 0
Code

installer: Update to Guile-Parted 0.0.2 release. 

* gnu/installer/parted.scm (data-partition?, metadata-partition?,
freespace-partition?, normal-partition?, extended-partition?,
logical-partition?): Remove, as now provided by Guile-Parted.
* gnu/installer/newt/partition.scm (run-disk-page): Remove disk-destroy calls,
replace disk-delete-all by disk-remove-all-partitions and
disk-delete-partition by disk-remove-partition*.
master
Mathieu Othacehe 2019-09-24 11:56:46 +02:00
parent a3246602a2
commit 70c7b7c799
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 7 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gnu/installer/newt/partition.scm
View File

@ -587,7 +587,6 @@ edit it."
disks)) disks))
(new-user-partitions (new-user-partitions
(remove-user-partition-by-disk user-partitions item))) (remove-user-partition-by-disk user-partitions item)))
(disk-destroy item)
`((disks . ,(cons new-disk other-disks)) `((disks . ,(cons new-disk other-disks))
(user-partitions . ,new-user-partitions))) (user-partitions . ,new-user-partitions)))
`((disks . ,disks) `((disks . ,disks)
@ -625,7 +624,7 @@ edit it."
info-text))) info-text)))
(case result (case result
((1) ((1)
(disk-delete-all item) (disk-remove-all-partitions item)
`((disks . ,disks) `((disks . ,disks)
(user-partitions (user-partitions
. ,(remove-user-partition-by-disk user-partitions item)))) . ,(remove-user-partition-by-disk user-partitions item))))
@ -649,7 +648,7 @@ edit it."
(let ((new-user-partitions (let ((new-user-partitions
(remove-user-partition-by-partition user-partitions (remove-user-partition-by-partition user-partitions
item))) item)))
(disk-delete-partition disk item) (disk-remove-partition* disk item)
`((disks . ,disks) `((disks . ,disks)
(user-partitions . ,new-user-partitions)))) (user-partitions . ,new-user-partitions))))
(else (else
@ -696,9 +695,7 @@ by pressing the Exit button.~%~%")))
#f)) #f))
(check-user-partitions user-partitions)))) (check-user-partitions user-partitions))))
(if user-partitions-ok? (if user-partitions-ok?
(begin user-partitions
(for-each (cut disk-destroy <>) disks)
user-partitions)
(run-disk-page disks user-partitions (run-disk-page disks user-partitions
#:guided? guided?))) #:guided? guided?)))
(let* ((result-disks (assoc-ref result 'disks)) (let* ((result-disks (assoc-ref result 'disks))

48
gnu/installer/parted.scm
View File

@ -64,13 +64,7 @@
user-partition-parted-object user-partition-parted-object
find-esp-partition find-esp-partition
data-partition?
metadata-partition?
freespace-partition?
small-freespace-partition? small-freespace-partition?
normal-partition?
extended-partition?
logical-partition?
esp-partition? esp-partition?
boot-partition? boot-partition?
default-esp-mount-point default-esp-mount-point
@ -172,24 +166,6 @@
"Find and return the ESP partition among PARTITIONS." "Find and return the ESP partition among PARTITIONS."
(find esp-partition? partitions)) (find esp-partition? partitions))
(define (data-partition? partition)
"Return #t if PARTITION is a partition dedicated to data (by opposition to
freespace, metadata and protected partition types), return #f otherwise."
(let ((type (partition-type partition)))
(not (any (lambda (flag)
(member flag type))
'(free-space metadata protected)))))
(define (metadata-partition? partition)
"Return #t if PARTITION is a metadata partition, #f otherwise."
(let ((type (partition-type partition)))
(member 'metadata type)))
(define (freespace-partition? partition)
"Return #t if PARTITION is a free-space partition, #f otherwise."
(let ((type (partition-type partition)))
(member 'free-space type)))
(define* (small-freespace-partition? device (define* (small-freespace-partition? device
partition partition
#:key (max-size MEBIBYTE-SIZE)) #:key (max-size MEBIBYTE-SIZE))
@ -200,21 +176,6 @@ inferior to MAX-SIZE, #f otherwise."
(device-sector-size device)))) (device-sector-size device))))
(< size max-sector-size))) (< size max-sector-size)))
(define (normal-partition? partition)
"return #t if partition is a normal partition, #f otherwise."
(let ((type (partition-type partition)))
(member 'normal type)))
(define (extended-partition? partition)
"return #t if partition is an extended partition, #f otherwise."
(let ((type (partition-type partition)))
(member 'extended type)))
(define (logical-partition? partition)
"Return #t if PARTITION is a logical partition, #f otherwise."
(let ((type (partition-type partition)))
(member 'logical type)))
(define (partition-user-type partition) (define (partition-user-type partition)
"Return the type of PARTITION, to be stored in the TYPE field of "Return the type of PARTITION, to be stored in the TYPE field of
<user-partition> record. It can be 'normal, 'extended or 'logical." <user-partition> record. It can be 'normal, 'extended or 'logical."
@ -813,7 +774,7 @@ cause them to cross."
(define (rmpart disk number) (define (rmpart disk number)
"Remove the partition with the given NUMBER on DISK." "Remove the partition with the given NUMBER on DISK."
(let ((partition (disk-get-partition disk number))) (let ((partition (disk-get-partition disk number)))
(disk-remove-partition disk partition))) (disk-remove-partition* disk partition)))
;; ;;
@ -928,12 +889,12 @@ exists."
(if has-extended? (if has-extended?
;; msdos - remove everything. ;; msdos - remove everything.
(disk-delete-all disk) (disk-remove-all-partitions disk)
;; gpt - remove everything but esp if it exists. ;; gpt - remove everything but esp if it exists.
(for-each (for-each
(lambda (partition) (lambda (partition)
(and (data-partition? partition) (and (data-partition? partition)
(disk-remove-partition disk partition))) (disk-remove-partition* disk partition)))
non-boot-partitions)) non-boot-partitions))
(let* ((start-partition (let* ((start-partition
@ -1348,7 +1309,7 @@ USER-PARTITIONS, or return nothing."
(define (init-parted) (define (init-parted)
"Initialize libparted support." "Initialize libparted support."
(probe-all-devices) (probe-all-devices!)
(exception-set-handler (lambda (exception) (exception-set-handler (lambda (exception)
EXCEPTION-OPTION-UNHANDLED))) EXCEPTION-OPTION-UNHANDLED)))
@ -1364,7 +1325,6 @@ the devices not to be used before returning."
;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html. ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html.
(let ((device-file-names (map device-path devices))) (let ((device-file-names (map device-path devices)))
(for-each force-device-sync devices) (for-each force-device-sync devices)
(free-all-devices)
(for-each (lambda (file-name) (for-each (lambda (file-name)
(let ((in-use? (with-delay-device-in-use? file-name))) (let ((in-use? (with-delay-device-in-use? file-name)))
(and in-use? (and in-use?