[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
93/197: installer: Add a dedicated make to format filesystems.
From: |
Danny Milosavljevic |
Subject: |
93/197: installer: Add a dedicated make to format filesystems. |
Date: |
Mon, 3 Jul 2017 20:37:06 -0400 (EDT) |
dannym pushed a commit to branch wip-installer-2
in repository guix.
commit 6f6ebcfb72ac0462ea5c082bec816e692946d24d
Author: John Darrington <address@hidden>
Date: Sun Jan 15 12:45:00 2017 +0100
installer: Add a dedicated make to format filesystems.
* gnu/system/installer/format.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
gnu/local.mk | 1 +
gnu/system/installer/format.scm | 154 ++++++++++++++++++++++++++++++
gnu/system/installer/guixsd-installer.scm | 10 ++
3 files changed, 165 insertions(+)
diff --git a/gnu/local.mk b/gnu/local.mk
index 20284f9..39a1a96 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -471,6 +471,7 @@ GNU_SYSTEM_MODULES = \
%D%/system/installer/mount-point.scm \
%D%/system/installer/guixsd-installer.scm \
%D%/system/installer/disks.scm \
+ %D%/system/installer/format.scm \
%D%/system/installer/ping.scm \
%D%/system/installer/key-map.scm \
%D%/system/installer/role.scm \
diff --git a/gnu/system/installer/format.scm b/gnu/system/installer/format.scm
new file mode 100644
index 0000000..2f965cc
--- /dev/null
+++ b/gnu/system/installer/format.scm
@@ -0,0 +1,154 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 John Darrington <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system installer format)
+ #:use-module (gnu system installer page)
+ #:use-module (gnu system installer misc)
+ #:use-module (gnu system installer filesystems)
+ #:use-module (gnu system installer utils)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 match)
+ #:use-module (gurses buttons)
+ #:use-module (ncurses curses)
+
+ #:export (make-format-page))
+
+
+(define (make-format-page parent title)
+ (let ((page (make-page (page-surface parent)
+ title
+ format-page-refresh
+ 0
+ format-page-key-handler)))
+ page))
+
+
+(define my-buttons `((format ,(N_ "_Format") #t)
+ (cancel ,(N_ "Canc_el") #t)))
+
+
+(define (format-page-key-handler page ch)
+
+ (let ((nav (page-datum page 'navigation))
+ (config-window (page-datum page 'config-window)))
+
+ (cond
+ ((eq? ch KEY_RIGHT)
+ (buttons-select-next nav))
+
+ ((eq? ch #\tab)
+ (cond
+ ((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
+ (buttons-unselect-all nav))
+
+ (else
+ (buttons-select-next nav))))
+
+ ((eq? ch KEY_LEFT)
+ (buttons-select-prev nav))
+
+ ((eq? ch KEY_UP)
+ (buttons-unselect-all nav))
+
+
+ ((buttons-key-matches-symbol? nav ch 'cancel)
+ ;; Close the menu and return
+ (page-leave))
+
+
+ ((buttons-key-matches-symbol? nav ch 'format)
+ (let ((window-port (make-window-port config-window)))
+ (for-each
+ (lambda (x)
+ (match x
+ ((dev . (? file-system-spec? fss))
+ (let ((cmd (string-append "mkfs." (file-system-spec-type
fss))))
+ (zero? (pipe-cmd window-port
+ cmd cmd
+ "-L" (file-system-spec-label fss)
+ "-U" (file-system-spec-uuid fss)
+ "-v"
+ dev))
+ )))) mount-points)
+
+ (close-port window-port))
+
+ ;;(page-leave)
+ ))
+
+ #f))
+
+(define (format-page-refresh page)
+ (when (not (page-initialised? page))
+ (format-page-init page)
+ (page-set-initialised! page #t))
+ (touchwin (outer (page-wwin page)))
+ (refresh (outer (page-wwin page)))
+ (refresh (inner (page-wwin page))))
+
+
+(define (format-page-init p)
+ (let* ((s (page-surface p))
+ (pr (make-boxed-window #f
+ (- (getmaxy s) 4) (- (getmaxx s) 2)
+ 2 1
+ #:title (page-title p)))
+
+ (text-window (derwin
+ (inner pr)
+ 3 (getmaxx (inner pr))
+ 0 0
+ #:panel #f))
+
+ (bwin (derwin (inner pr)
+ 3 (getmaxx (inner pr))
+ (- (getmaxy (inner pr)) 3) 0
+ #:panel #f))
+ (buttons (make-buttons my-buttons 1))
+
+
+ (config-window (make-boxed-window
+ (inner pr)
+ (- (getmaxy (inner pr))
+ (getmaxy bwin)
+ (getmaxy text-window))
+ (getmaxx (inner pr))
+ (getmaxy text-window)
+ 0)))
+
+ (addstr* text-window
+ (gettext
+ (format #f
+ "The partitions ~s will be formatted. All data on
these partitions will be destroyed if you continue."
+ (map (lambda (x)
+ (car x))
+ mount-points))))
+
+
+
+ (push-cursor (page-cursor-visibility p))
+ (page-set-wwin! p pr)
+ (page-set-datum! p 'navigation buttons)
+ (page-set-datum! p 'config-window (inner config-window))
+ (buttons-post buttons bwin)
+ (refresh (outer pr))
+ (refresh text-window)
+
+ (refresh (outer config-window))
+
+ (refresh bwin)))
diff --git a/gnu/system/installer/guixsd-installer.scm
b/gnu/system/installer/guixsd-installer.scm
index 8314d08..1be2bea 100644
--- a/gnu/system/installer/guixsd-installer.scm
+++ b/gnu/system/installer/guixsd-installer.scm
@@ -33,6 +33,7 @@
(gnu system installer role)
(gnu system installer network)
(gnu system installer install)
+ (gnu system installer format)
(gnu system installer page)
(gnu system installer ping)
(gnu system installer dialog)
@@ -57,6 +58,7 @@
(define partition-menu-title (N_ "Partition the disk(s)"))
(define filesystem-menu-title (N_ "Allocate disk partitions"))
+(define format-menu-title (N_ "Format the partitions"))
(define network-menu-title (N_ "Set up the network"))
(define timezone-menu-title (N_ "Set the time zone"))
(define hostname-menu-title (N_ "Set the host name"))
@@ -85,6 +87,14 @@
page
filesystem-menu-title))))
+ (format . ,(make-task format-menu-title
+ '(filesystems)
+ (lambda () #f)
+ (lambda (page)
+ (make-format-page
+ page
+ format-menu-title))))
+
(network . ,(make-task network-menu-title
'()
substitute-is-reachable?
- 190/197: gurses: forms: Minor refactor., (continued)
- 190/197: gurses: forms: Minor refactor., Danny Milosavljevic, 2017/07/03
- 194/197: guix system: Remove outdated (gnu system grub) import., Danny Milosavljevic, 2017/07/03
- 197/197: installer: Use "G_" instead of "_"., Danny Milosavljevic, 2017/07/03
- 188/197: installer: Go back to main menu after "cancel", Danny Milosavljevic, 2017/07/03
- 184/197: installer: Create dedicated module to maintainer the page stack., Danny Milosavljevic, 2017/07/03
- 126/197: installer: mount-points page: Enlarge the forms window., Danny Milosavljevic, 2017/07/03
- 96/197: installer: Changed N_ to M_ since N_ is used for another purpose in guix/ui.scm, Danny Milosavljevic, 2017/07/03
- 142/197: gurses: xchar->char: New procedure., Danny Milosavljevic, 2017/07/03
- 85/197: installer: Use "lspci -mm" instead of "lspci -m"., Danny Milosavljevic, 2017/07/03
- 88/197: installer: Use a cleaner method of detecting wireless capability for ethernet interfaces., Danny Milosavljevic, 2017/07/03
- 93/197: installer: Add a dedicated make to format filesystems.,
Danny Milosavljevic <=
- 100/197: installer: Do not perform tasks more than once., Danny Milosavljevic, 2017/07/03
- 106/197: installer: Properly handle swap partitions when generating the configuration., Danny Milosavljevic, 2017/07/03
- 114/197: installer: Check that swap spaces have not been assigned mount points, Danny Milosavljevic, 2017/07/03
- 112/197: gurses: form: Use match instead of car, cdr etc., Danny Milosavljevic, 2017/07/03
- 125/197: installer: Do not assume the root file system is of type "ext4"., Danny Milosavljevic, 2017/07/03
- 130/197: installer: Delete unused procedure "justify"., Danny Milosavljevic, 2017/07/03
- 134/197: installer: Tolerate an undefined system role in config generation., Danny Milosavljevic, 2017/07/03
- 137/197: installer: Prepare for new wireless network features., Danny Milosavljevic, 2017/07/03
- 140/197: installer: Fix the key map option., Danny Milosavljevic, 2017/07/03
- 132/197: installer: Add new procedure to check file system specifications., Danny Milosavljevic, 2017/07/03