summaryrefslogtreecommitdiff
path: root/gnu/installer/locale.scm
diff options
context:
space:
mode:
authorMathieu Othacehe <m.othacehe@gmail.com>2018-11-16 20:43:55 +0900
committerLudovic Courtès <ludo@gnu.org>2019-01-17 14:04:20 +0100
commitd0f3a672dcbdfefd3556b6a21985ff0e35eed3be (patch)
tree6ca7cc2fc874343791a3b555181177be488a3a8a /gnu/installer/locale.scm
parent08af580bde01ffd8e6968b6f9f9eff14c4f9cc5a (diff)
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.
Diffstat (limited to 'gnu/installer/locale.scm')
-rw-r--r--gnu/installer/locale.scm199
1 files changed, 199 insertions, 0 deletions
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
new file mode 100644
index 0000000000..504070d41d
--- /dev/null
+++ b/gnu/installer/locale.scm
@@ -0,0 +1,199 @@
+;;; 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 locale)
+ #:use-module (gnu installer utils)
+ #:use-module (guix records)
+ #:use-module (json)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
+ #:export (locale-language
+ locale-territory
+ locale-codeset
+ locale-modifier
+
+ locale->locale-string
+ supported-locales->locales
+
+ iso639->iso639-languages
+ language-code->language-name
+
+ iso3166->iso3166-territories
+ territory-code->territory-name))
+
+
+;;;
+;;; Locale.
+;;;
+
+;; A glibc locale string has the following format:
+;; language[_territory[.codeset][@modifier]].
+(define locale-regexp "^([^_@]+)(_([^\\.@]+))?(\\.([^@]+))?(@([^$]+))?$")
+
+;; LOCALE will be better expressed in a (guix record) that in an association
+;; list. However, loading large files containing records does not scale
+;; well. The same thing goes for ISO639 and ISO3166 association lists used
+;; later in this module.
+(define (locale-language assoc)
+ (assoc-ref assoc 'language))
+(define (locale-territory assoc)
+ (assoc-ref assoc 'territory))
+(define (locale-codeset assoc)
+ (assoc-ref assoc 'codeset))
+(define (locale-modifier assoc)
+ (assoc-ref assoc 'modifier))
+
+(define (locale-string->locale string)
+ "Return the locale association list built from the parsing of STRING."
+ (let ((matches (string-match locale-regexp string)))
+ `((language . ,(match:substring matches 1))
+ (territory . ,(match:substring matches 3))
+ (codeset . ,(match:substring matches 5))
+ (modifier . ,(match:substring matches 7)))))
+
+(define (locale->locale-string locale)
+ "Reverse operation of locale-string->locale."
+ (let ((language (locale-language locale))
+ (territory (locale-territory locale))
+ (codeset (locale-codeset locale))
+ (modifier (locale-modifier locale)))
+ (apply string-append
+ `(,language
+ ,@(if territory
+ `("_" ,territory)
+ '())
+ ,@(if codeset
+ `("." ,codeset)
+ '())
+ ,@(if modifier
+ `("@" ,modifier)
+ '())))))
+
+(define (supported-locales->locales supported-locales)
+ "Parse the SUPPORTED-LOCALES file from the glibc and return the matching
+list of LOCALE association lists."
+ (call-with-input-file supported-locales
+ (lambda (port)
+ (let ((lines (read-lines port)))
+ (map (lambda (line)
+ (match (string-split line #\ )
+ ((locale-string codeset)
+ (let ((line-locale (locale-string->locale locale-string)))
+ (assoc-set! line-locale 'codeset codeset)))))
+ lines)))))
+
+
+;;;
+;;; Language.
+;;;
+
+(define (iso639-language-alpha2 assoc)
+ (assoc-ref assoc 'alpha2))
+
+(define (iso639-language-alpha3 assoc)
+ (assoc-ref assoc 'alpha3))
+
+(define (iso639-language-name assoc)
+ (assoc-ref assoc 'name))
+
+(define (supported-locale? locales alpha2 alpha3)
+ "Find a locale in LOCALES whose alpha2 field matches ALPHA-2 or alpha3 field
+matches ALPHA-3. The ISO639 standard specifies that ALPHA-2 is optional. Thus,
+if ALPHA-2 is #f, only consider ALPHA-3. Return #f if not matching locale was
+found."
+ (find (lambda (locale)
+ (let ((language (locale-language locale)))
+ (or (and=> alpha2
+ (lambda (code)
+ (string=? language code)))
+ (string=? language alpha3))))
+ locales))
+
+(define (iso639->iso639-languages locales iso639-3 iso639-5)
+ "Return a list of ISO639 association lists created from the parsing of
+ISO639-3 and ISO639-5 files."
+ (call-with-input-file iso639-3
+ (lambda (port-iso639-3)
+ (call-with-input-file iso639-5
+ (lambda (port-iso639-5)
+ (filter-map
+ (lambda (hash)
+ (let ((alpha2 (hash-ref hash "alpha_2"))
+ (alpha3 (hash-ref hash "alpha_3"))
+ (name (hash-ref hash "name")))
+ (and (supported-locale? locales alpha2 alpha3)
+ `((alpha2 . ,alpha2)
+ (alpha3 . ,alpha3)
+ (name . ,name)))))
+ (append
+ (hash-ref (json->scm port-iso639-3) "639-3")
+ (hash-ref (json->scm port-iso639-5) "639-5"))))))))
+
+(define (language-code->language-name languages language-code)
+ "Using LANGUAGES as a list of ISO639 association lists, return the language
+name corresponding to the given LANGUAGE-CODE."
+ (let ((iso639-language
+ (find (lambda (language)
+ (or
+ (and=> (iso639-language-alpha2 language)
+ (lambda (alpha2)
+ (string=? alpha2 language-code)))
+ (string=? (iso639-language-alpha3 language)
+ language-code)))
+ languages)))
+ (iso639-language-name iso639-language)))
+
+
+;;;
+;;; Territory.
+;;;
+
+(define (iso3166-territory-alpha2 assoc)
+ (assoc-ref assoc 'alpha2))
+
+(define (iso3166-territory-alpha3 assoc)
+ (assoc-ref assoc 'alpha3))
+
+(define (iso3166-territory-name assoc)
+ (assoc-ref assoc 'name))
+
+(define (iso3166->iso3166-territories iso3166)
+ "Return a list of ISO3166 association lists created from the parsing of
+ISO3166 file."
+ (call-with-input-file iso3166
+ (lambda (port)
+ (map (lambda (hash)
+ `((alpha2 . ,(hash-ref hash "alpha_2"))
+ (alpha3 . ,(hash-ref hash "alpha_3"))
+ (name . ,(hash-ref hash "name"))))
+ (hash-ref (json->scm port) "3166-1")))))
+
+(define (territory-code->territory-name territories territory-code)
+ "Using TERRITORIES as a list of ISO3166 association lists return the
+territory name corresponding to the given TERRITORY-CODE."
+ (let ((iso3166-territory
+ (find (lambda (territory)
+ (or
+ (and=> (iso3166-territory-alpha2 territory)
+ (lambda (alpha2)
+ (string=? alpha2 territory-code)))
+ (string=? (iso3166-territory-alpha3 territory)
+ territory-code)))
+ territories)))
+ (iso3166-territory-name iso3166-territory)))