From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 24 08:26:20 2019 Received: (at submit) by debbugs.gnu.org; 24 Sep 2019 12:26:20 +0000 Received: from localhost ([127.0.0.1]:37855 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iCjtc-0001xe-ET for submit@debbugs.gnu.org; Tue, 24 Sep 2019 08:26:20 -0400 Received: from lists.gnu.org ([209.51.188.17]:49917) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iCjtb-0001xX-7t for submit@debbugs.gnu.org; Tue, 24 Sep 2019 08:26:19 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:49420) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iCjtZ-0008Q6-H6 for guix-patches@gnu.org; Tue, 24 Sep 2019 08:26:19 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: ** X-Spam-Status: No, score=2.8 required=5.0 tests=BAYES_50,FREEMAIL_FROM, SPOOFED_FREEMAIL,URIBL_BLOCKED autolearn=disabled version=3.3.2 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iCjtX-0007mP-Hl for guix-patches@gnu.org; Tue, 24 Sep 2019 08:26:17 -0400 Received: from mail-wm1-x343.google.com ([2a00:1450:4864:20::343]:33094) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iCjtV-0007jg-JU for guix-patches@gnu.org; Tue, 24 Sep 2019 08:26:15 -0400 Received: by mail-wm1-x343.google.com with SMTP id r17so1516274wme.0 for ; Tue, 24 Sep 2019 05:26:12 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=Cqf2kuCUUFih2d4rt+sRKUIdiq+UdYkxb0E6DnJKeZY=; b=VgRf5ILidPe21KLFnR0CEqsmlaC76VaBIVTomu2zqAUmPDa1NPOLV0SoVcH4a5OmXU EzmR8CV8teHOQez6RC2bVm4gJK4nc3+QwQcdfyduaSUCvW8BCB1CF130eA6rkKrIGeQm Vj29+civlPYtu14/RvSJibdmwdBIXZIlO3BPt24/10+m+CNqawuWi8yPtEvaiiBgJZvd ofOTIMzoYrN6xrtokIufPrpV16Ve/9Gat5ZLS7VKRQ0Srcfe+iahTVLGF8qi8/DY8Fbw NLyO2TRWh/Po4zSw894rOJF66K9re939paPNrzyB3q7sJhd0CBwgjtmT/NugwMdQy/rG G7ng== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=Cqf2kuCUUFih2d4rt+sRKUIdiq+UdYkxb0E6DnJKeZY=; b=qbEue5YoqQxnmT4Jna3NFkwHLh4aKN9UIjpDw7vXiTIQTTmnj84hDIOSrIS76j8Wq1 93ah/GrBTnBI3qudCqzwTI5Hll2RrFScE2iFLaefxBg7lHSuVr3LiV3fFa3SiwecN48p SKAwhV1dOma0uW32Q7i3GWZ1K6BK3W0b7k4zyHv5MOc3g6VlAmJvtY21D5hCaXOl0HTA o3OaEBgu/8FDhlXHRFu3lvRJoZWu7yPen8ALa6wAcnjPG6jQJHqjR0CxC8ouTTHbhc91 x7hoGUwocPcyfN2fJCLqbh/ojcnxyp/WjZwZhKwqILEg2E9eIUU1fYQfw4IandwSbwcY H/5Q== X-Gm-Message-State: APjAAAVBsxmVXvksJGX1eYnq1uUs0/paKcw6DDSgTP9RMDp41IA4933Q 1Gtus3BCZOp3fkIhNNAIZ7jO8FQRs3A= X-Google-Smtp-Source: APXvYqyKxGwPJxWzhIdW8uQbSkKZCuyLDntbmSJ+AyQs55cYvCVr6WeRIm0eu9D8QuVJZ0g6tsmBzQ== X-Received: by 2002:a1c:c506:: with SMTP id v6mr2336905wmf.160.1569327970925; Tue, 24 Sep 2019 05:26:10 -0700 (PDT) Received: from localhost.localdomain ([90.114.71.216]) by smtp.gmail.com with ESMTPSA id y186sm4306417wmd.26.2019.09.24.05.26.08 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 24 Sep 2019 05:26:09 -0700 (PDT) From: Mathieu Othacehe To: guix-patches@gnu.org Subject: [PATCH] installer: Update to Guile-Parted 0.0.2 release. Date: Tue, 24 Sep 2019 14:26:03 +0200 Message-Id: <20190924122603.25583-1-m.othacehe@gmail.com> X-Mailer: git-send-email 2.23.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:4864:20::343 X-Spam-Score: 0.7 (/) X-Debbugs-Envelope-To: submit Cc: Mathieu Othacehe X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.3 (/) * 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*. --- gnu/installer/newt/partition.scm | 9 ++---- 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 7a9f11a15e..74e9473171 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -587,7 +587,6 @@ edit it." disks)) (new-user-partitions (remove-user-partition-by-disk user-partitions item))) - (disk-destroy item) `((disks . ,(cons new-disk other-disks)) (user-partitions . ,new-user-partitions))) `((disks . ,disks) @@ -625,7 +624,7 @@ edit it." info-text))) (case result ((1) - (disk-delete-all item) + (disk-remove-all-partitions item) `((disks . ,disks) (user-partitions . ,(remove-user-partition-by-disk user-partitions item)))) @@ -649,7 +648,7 @@ edit it." (let ((new-user-partitions (remove-user-partition-by-partition user-partitions item))) - (disk-delete-partition disk item) + (disk-remove-partition* disk item) `((disks . ,disks) (user-partitions . ,new-user-partitions)))) (else @@ -696,9 +695,7 @@ by pressing the Exit button.~%~%"))) #f)) (check-user-partitions user-partitions)))) (if user-partitions-ok? - (begin - (for-each (cut disk-destroy <>) disks) - user-partitions) + user-partitions (run-disk-page disks user-partitions #:guided? guided?))) (let* ((result-disks (assoc-ref result 'disks)) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 682e233d9f..3439f211e2 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -64,13 +64,7 @@ user-partition-parted-object find-esp-partition - data-partition? - metadata-partition? - freespace-partition? small-freespace-partition? - normal-partition? - extended-partition? - logical-partition? esp-partition? boot-partition? default-esp-mount-point @@ -172,24 +166,6 @@ "Find and return the ESP partition among 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 partition #:key (max-size MEBIBYTE-SIZE)) @@ -200,21 +176,6 @@ inferior to MAX-SIZE, #f otherwise." (device-sector-size device)))) (< 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) "Return the type of PARTITION, to be stored in the TYPE field of record. It can be 'normal, 'extended or 'logical." @@ -813,7 +774,7 @@ cause them to cross." (define (rmpart disk number) "Remove the partition with the given NUMBER on DISK." (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? ;; msdos - remove everything. - (disk-delete-all disk) + (disk-remove-all-partitions disk) ;; gpt - remove everything but esp if it exists. (for-each (lambda (partition) (and (data-partition? partition) - (disk-remove-partition disk partition))) + (disk-remove-partition* disk partition))) non-boot-partitions)) (let* ((start-partition @@ -1348,7 +1309,7 @@ USER-PARTITIONS, or return nothing." (define (init-parted) "Initialize libparted support." - (probe-all-devices) + (probe-all-devices!) (exception-set-handler (lambda (exception) 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. (let ((device-file-names (map device-path devices))) (for-each force-device-sync devices) - (free-all-devices) (for-each (lambda (file-name) (let ((in-use? (with-delay-device-in-use? file-name))) (and in-use? -- 2.23.0