diff options
| author | Mathieu Othacehe <m.othacehe@gmail.com> | 2019-09-24 11:56:46 +0200 |
|---|---|---|
| committer | Mathieu Othacehe <m.othacehe@gmail.com> | 2019-09-25 16:03:23 +0200 |
| commit | 70c7b7c79920dd6500ba5e4e88fe147cc44923d8 (patch) | |
| tree | 6c007b20c7fca3058c5ad1e658282377b5e0f352 /gnu/installer | |
| parent | a3246602a271540b3ab21eb904b287da4f324eb8 (diff) | |
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*.
Diffstat (limited to 'gnu/installer')
| -rw-r--r-- | gnu/installer/newt/partition.scm | 9 | ||||
| -rw-r--r-- | gnu/installer/parted.scm | 48 |
2 files changed, 7 insertions, 50 deletions
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 7a9f11a15e6..74e94731710 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm | |||
| @@ -587,7 +587,6 @@ edit it." | |||
| 587 | disks)) | 587 | disks)) |
| 588 | (new-user-partitions | 588 | (new-user-partitions |
| 589 | (remove-user-partition-by-disk user-partitions item))) | 589 | (remove-user-partition-by-disk user-partitions item))) |
| 590 | (disk-destroy item) | ||
| 591 | `((disks . ,(cons new-disk other-disks)) | 590 | `((disks . ,(cons new-disk other-disks)) |
| 592 | (user-partitions . ,new-user-partitions))) | 591 | (user-partitions . ,new-user-partitions))) |
| 593 | `((disks . ,disks) | 592 | `((disks . ,disks) |
| @@ -625,7 +624,7 @@ edit it." | |||
| 625 | info-text))) | 624 | info-text))) |
| 626 | (case result | 625 | (case result |
| 627 | ((1) | 626 | ((1) |
| 628 | (disk-delete-all item) | 627 | (disk-remove-all-partitions item) |
| 629 | `((disks . ,disks) | 628 | `((disks . ,disks) |
| 630 | (user-partitions | 629 | (user-partitions |
| 631 | . ,(remove-user-partition-by-disk user-partitions item)))) | 630 | . ,(remove-user-partition-by-disk user-partitions item)))) |
| @@ -649,7 +648,7 @@ edit it." | |||
| 649 | (let ((new-user-partitions | 648 | (let ((new-user-partitions |
| 650 | (remove-user-partition-by-partition user-partitions | 649 | (remove-user-partition-by-partition user-partitions |
| 651 | item))) | 650 | item))) |
| 652 | (disk-delete-partition disk item) | 651 | (disk-remove-partition* disk item) |
| 653 | `((disks . ,disks) | 652 | `((disks . ,disks) |
| 654 | (user-partitions . ,new-user-partitions)))) | 653 | (user-partitions . ,new-user-partitions)))) |
| 655 | (else | 654 | (else |
| @@ -696,9 +695,7 @@ by pressing the Exit button.~%~%"))) | |||
| 696 | #f)) | 695 | #f)) |
| 697 | (check-user-partitions user-partitions)))) | 696 | (check-user-partitions user-partitions)))) |
| 698 | (if user-partitions-ok? | 697 | (if user-partitions-ok? |
| 699 | (begin | 698 | user-partitions |
| 700 | (for-each (cut disk-destroy <>) disks) | ||
| 701 | user-partitions) | ||
| 702 | (run-disk-page disks user-partitions | 699 | (run-disk-page disks user-partitions |
| 703 | #:guided? guided?))) | 700 | #:guided? guided?))) |
| 704 | (let* ((result-disks (assoc-ref result 'disks)) | 701 | (let* ((result-disks (assoc-ref result 'disks)) |
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 682e233d9f0..3439f211e24 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm | |||
| @@ -64,13 +64,7 @@ | |||
| 64 | user-partition-parted-object | 64 | user-partition-parted-object |
| 65 | 65 | ||
| 66 | find-esp-partition | 66 | find-esp-partition |
| 67 | data-partition? | ||
| 68 | metadata-partition? | ||
| 69 | freespace-partition? | ||
| 70 | small-freespace-partition? | 67 | small-freespace-partition? |
| 71 | normal-partition? | ||
| 72 | extended-partition? | ||
| 73 | logical-partition? | ||
| 74 | esp-partition? | 68 | esp-partition? |
| 75 | boot-partition? | 69 | boot-partition? |
| 76 | default-esp-mount-point | 70 | default-esp-mount-point |
| @@ -172,24 +166,6 @@ | |||
| 172 | "Find and return the ESP partition among PARTITIONS." | 166 | "Find and return the ESP partition among PARTITIONS." |
| 173 | (find esp-partition? partitions)) | 167 | (find esp-partition? partitions)) |
| 174 | 168 | ||
| 175 | (define (data-partition? partition) | ||
| 176 | "Return #t if PARTITION is a partition dedicated to data (by opposition to | ||
| 177 | freespace, metadata and protected partition types), return #f otherwise." | ||
| 178 | (let ((type (partition-type partition))) | ||
| 179 | (not (any (lambda (flag) | ||
| 180 | (member flag type)) | ||
| 181 | '(free-space metadata protected))))) | ||
| 182 | |||
| 183 | (define (metadata-partition? partition) | ||
| 184 | "Return #t if PARTITION is a metadata partition, #f otherwise." | ||
| 185 | (let ((type (partition-type partition))) | ||
| 186 | (member 'metadata type))) | ||
| 187 | |||
| 188 | (define (freespace-partition? partition) | ||
| 189 | "Return #t if PARTITION is a free-space partition, #f otherwise." | ||
| 190 | (let ((type (partition-type partition))) | ||
| 191 | (member 'free-space type))) | ||
| 192 | |||
| 193 | (define* (small-freespace-partition? device | 169 | (define* (small-freespace-partition? device |
| 194 | partition | 170 | partition |
| 195 | #:key (max-size MEBIBYTE-SIZE)) | 171 | #:key (max-size MEBIBYTE-SIZE)) |
| @@ -200,21 +176,6 @@ inferior to MAX-SIZE, #f otherwise." | |||
| 200 | (device-sector-size device)))) | 176 | (device-sector-size device)))) |
| 201 | (< size max-sector-size))) | 177 | (< size max-sector-size))) |
| 202 | 178 | ||
| 203 | (define (normal-partition? partition) | ||
| 204 | "return #t if partition is a normal partition, #f otherwise." | ||
| 205 | (let ((type (partition-type partition))) | ||
| 206 | (member 'normal type))) | ||
| 207 | |||
| 208 | (define (extended-partition? partition) | ||
| 209 | "return #t if partition is an extended partition, #f otherwise." | ||
| 210 | (let ((type (partition-type partition))) | ||
| 211 | (member 'extended type))) | ||
| 212 | |||
| 213 | (define (logical-partition? partition) | ||
| 214 | "Return #t if PARTITION is a logical partition, #f otherwise." | ||
| 215 | (let ((type (partition-type partition))) | ||
| 216 | (member 'logical type))) | ||
| 217 | |||
| 218 | (define (partition-user-type partition) | 179 | (define (partition-user-type partition) |
| 219 | "Return the type of PARTITION, to be stored in the TYPE field of | 180 | "Return the type of PARTITION, to be stored in the TYPE field of |
| 220 | <user-partition> record. It can be 'normal, 'extended or 'logical." | 181 | <user-partition> record. It can be 'normal, 'extended or 'logical." |
| @@ -813,7 +774,7 @@ cause them to cross." | |||
| 813 | (define (rmpart disk number) | 774 | (define (rmpart disk number) |
| 814 | "Remove the partition with the given NUMBER on DISK." | 775 | "Remove the partition with the given NUMBER on DISK." |
| 815 | (let ((partition (disk-get-partition disk number))) | 776 | (let ((partition (disk-get-partition disk number))) |
| 816 | (disk-remove-partition disk partition))) | 777 | (disk-remove-partition* disk partition))) |
| 817 | 778 | ||
| 818 | 779 | ||
| 819 | ;; | 780 | ;; |
| @@ -928,12 +889,12 @@ exists." | |||
| 928 | 889 | ||
| 929 | (if has-extended? | 890 | (if has-extended? |
| 930 | ;; msdos - remove everything. | 891 | ;; msdos - remove everything. |
| 931 | (disk-delete-all disk) | 892 | (disk-remove-all-partitions disk) |
| 932 | ;; gpt - remove everything but esp if it exists. | 893 | ;; gpt - remove everything but esp if it exists. |
| 933 | (for-each | 894 | (for-each |
| 934 | (lambda (partition) | 895 | (lambda (partition) |
| 935 | (and (data-partition? partition) | 896 | (and (data-partition? partition) |
| 936 | (disk-remove-partition disk partition))) | 897 | (disk-remove-partition* disk partition))) |
| 937 | non-boot-partitions)) | 898 | non-boot-partitions)) |
| 938 | 899 | ||
| 939 | (let* ((start-partition | 900 | (let* ((start-partition |
| @@ -1348,7 +1309,7 @@ USER-PARTITIONS, or return nothing." | |||
| 1348 | 1309 | ||
| 1349 | (define (init-parted) | 1310 | (define (init-parted) |
| 1350 | "Initialize libparted support." | 1311 | "Initialize libparted support." |
| 1351 | (probe-all-devices) | 1312 | (probe-all-devices!) |
| 1352 | (exception-set-handler (lambda (exception) | 1313 | (exception-set-handler (lambda (exception) |
| 1353 | EXCEPTION-OPTION-UNHANDLED))) | 1314 | EXCEPTION-OPTION-UNHANDLED))) |
| 1354 | 1315 | ||
| @@ -1364,7 +1325,6 @@ the devices not to be used before returning." | |||
| 1364 | ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html. | 1325 | ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html. |
| 1365 | (let ((device-file-names (map device-path devices))) | 1326 | (let ((device-file-names (map device-path devices))) |
| 1366 | (for-each force-device-sync devices) | 1327 | (for-each force-device-sync devices) |
| 1367 | (free-all-devices) | ||
| 1368 | (for-each (lambda (file-name) | 1328 | (for-each (lambda (file-name) |
| 1369 | (let ((in-use? (with-delay-device-in-use? file-name))) | 1329 | (let ((in-use? (with-delay-device-in-use? file-name))) |
| 1370 | (and in-use? | 1330 | (and in-use? |
