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*.
This commit is contained in:
parent
a3246602a2
commit
70c7b7c799
|
@ -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))
|
||||||
|
|
|
@ -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?
|
||||||
|
|
Loading…
Reference in New Issue