gnu: Add graphical installer support.

* configure.ac: Require that guile-newt is available.
* gnu/installer.scm: New file.
* gnu/installer/aux-files/logo.txt: New file.
* gnu/installer/build-installer.scm: New file.
* gnu/installer/connman.scm: New file.
* gnu/installer/keymap.scm: New file.
* gnu/installer/locale.scm: New file.
* gnu/installer/newt.scm: New file.
* gnu/installer/newt/ethernet.scm: New file.
* gnu/installer/newt/hostname.scm: New file.
* gnu/installer/newt/keymap.scm: New file.
* gnu/installer/newt/locale.scm: New file.
* gnu/installer/newt/menu.scm: New file.
* gnu/installer/newt/network.scm: New file.
* gnu/installer/newt/page.scm: New file.
* gnu/installer/newt/timezone.scm: New file.
* gnu/installer/newt/user.scm: New file.
* gnu/installer/newt/utils.scm: New file.
* gnu/installer/newt/welcome.scm: New file.
* gnu/installer/newt/wifi.scm: New file.
* gnu/installer/steps.scm: New file.
* gnu/installer/timezone.scm: New file.
* gnu/installer/utils.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add previous files.
* gnu/system.scm: Export %root-account.
* gnu/system/install.scm (%installation-services): Use kmscon instead of linux
VT for all tty.
(installation-os)[users]: Add the graphical installer as shell of the root
account.
[packages]: Add font related packages.
* po/guix/POTFILES.in: Add installer files.

1 files changed, 193 insertions, 0 deletions

diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
new file mode 100644
index 0000000000..5444a07598
--- /dev/null
+++ b/gnu/installer/newt/locale.scm
@@ -0,0 +1,193 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; 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 installer newt locale)
+  #:use-module (gnu installer locale)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (newt)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
+  #:export (run-locale-page))
+
+(define (run-language-page languages language->text)
+  (let ((title (G_ "Language selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose the language to be used for the installation \
+process. The selected language will also be the default \
+language for the installed system.")
+     #:listbox-items languages
+     #:listbox-item->text language->text
+     #:button-text (G_ "Cancel")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-territory-page territories territory->text)
+  (let ((title (G_ "Location selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose your location. This is a shortlist of locations \
+based on the language you selected.")
+     #:listbox-items territories
+     #:listbox-item->text territory->text
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-codeset-page codesets)
+  (let ((title (G_ "Codeset selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose your codeset. If UTF-8 is available, it should be \
+preferred.")
+     #:listbox-items codesets
+     #:listbox-item->text identity
+     #:listbox-default-item "UTF-8"
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-modifier-page modifiers modifier->text)
+  (let ((title (G_ "Modifier selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose your modifier.")
+     #:listbox-items modifiers
+     #:listbox-item->text modifier->text
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define* (run-locale-page #:key
+                          supported-locales
+                          iso639-languages
+                          iso3166-territories)
+
+  (define (break-on-locale-found locales)
+    "Raise the &installer-step-break condition if LOCALES contains exactly one
+element."
+    (and (= (length locales) 1)
+         (raise
+          (condition (&installer-step-break)))))
+
+  (define (filter-locales locales result)
+    "Filter the list of locale records LOCALES using the RESULT returned by
+the installer-steps defined below."
+    (filter
+     (lambda (locale)
+       (and-map identity
+                `(,(string=? (locale-language locale)
+                             (result-step result 'language))
+                  ,@(if (result-step-done? result 'territory)
+                        (list (equal? (locale-territory locale)
+                                      (result-step result 'territory)))
+                        '())
+                  ,@(if (result-step-done? result 'codeset)
+                        (list (equal? (locale-codeset locale)
+                                      (result-step result 'codeset)))
+                        '())
+                  ,@(if (result-step-done? result 'modifier)
+                        (list (equal? (locale-modifier locale)
+                                      (result-step result 'modifier)))
+                        '()))))
+     locales))
+
+  (define (result->locale-string locales result)
+    "Supposing that LOCALES contains exactly one locale record, turn it into a
+glibc locale string and return it."
+    (match (filter-locales locales result)
+      ((locale)
+       (locale->locale-string locale))))
+
+  (define locale-steps
+    (list
+     (installer-step
+      (id 'language)
+      (compute
+       (lambda _
+         (run-language-page
+          (delete-duplicates (map locale-language supported-locales))
+          (cut language-code->language-name iso639-languages <>)))))
+     (installer-step
+      (id 'territory)
+      (compute
+       (lambda (result)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Stop the process if the language returned by the previous step
+           ;; is matching one and only one supported locale.
+           (break-on-locale-found locales)
+
+           ;; Otherwise, ask the user to select a territory among those
+           ;; supported by the previously selected language.
+           (run-territory-page
+            (delete-duplicates (map locale-territory locales))
+            (lambda (territory-code)
+              (if territory-code
+                  (territory-code->territory-name iso3166-territories
+                                                  territory-code)
+                  (G_ "No location"))))))))
+     (installer-step
+      (id 'codeset)
+      (compute
+       (lambda (result)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Same as above but we now have a language and a territory to
+           ;; narrow down the search of a locale.
+           (break-on-locale-found locales)
+
+           ;; Otherwise, ask for a codeset.
+           (run-codeset-page
+            (delete-duplicates (map locale-codeset locales)))))))
+     (installer-step
+      (id 'modifier)
+      (compute
+       (lambda (result)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Same thing with a language, a territory and a codeset this time.
+           (break-on-locale-found locales)
+
+           ;; Otherwise, ask for a modifier.
+           (run-modifier-page
+            (delete-duplicates (map locale-modifier locales))
+            (lambda (modifier)
+              (or modifier (G_ "No modifier"))))))))))
+
+  ;; If run-installer-steps returns locally, it means that the user had to go
+  ;; through all steps (language, territory, codeset and modifier) to select a
+  ;; locale. In that case, like if we exited by raising &installer-step-break
+  ;; condition, turn the result into a glibc locale string and return it.
+  (result->locale-string
+   supported-locales
+   (run-installer-steps #:steps locale-steps)))