;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe ;;; Copyright © 2019 Ludovic Courtès ;;; ;;; 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 . (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) (define result (run-listbox-selection-page #:title (G_ "Locale language") #:info-text (G_ "Choose the language to use for the \ installation process and for the installed system.") #:info-textbox-width 70 #:listbox-items languages #:listbox-item->text language->text #:sort-listbox-items? #f #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ (abort-to-prompt 'installer-step 'abort)))) ;; Immediately install the chosen language so that the territory page that ;; comes after (optionally) is displayed in the chosen language. (setenv "LANGUAGE" result) result) (define (run-territory-page territories territory->text) (let ((title (G_ "Locale location"))) (run-listbox-selection-page #:title title #:info-text (G_ "Choose a territory for this language.") #:listbox-items territories #:listbox-item->text territory->text #:button-text (G_ "Back") #:button-callback-procedure (lambda _ (abort-to-prompt 'installer-step 'abort))))) (define (run-codeset-page codesets) (let ((title (G_ "Locale codeset"))) (run-listbox-selection-page #:title title #:info-text (G_ "Choose the locale encoding.") #:listbox-items codesets #:listbox-item->text identity #:listbox-default-item "UTF-8" #:button-text (G_ "Back") #:button-callback-procedure (lambda _ (abort-to-prompt 'installer-step 'abort))))) (define (run-modifier-page modifiers modifier->text) (let ((title (G_ "Locale modifier"))) (run-listbox-selection-page #:title title #:info-text (G_ "Choose your locale's modifier. The most frequent \ modifier is euro. It indicates that you want to use Euro as the currency \ symbol.") #:listbox-items modifiers #:listbox-item->text modifier->text #:button-text (G_ "Back") #:button-callback-procedure (lambda _ (abort-to-prompt 'installer-step 'abort))))) (define* (run-locale-page #:key supported-locales iso639-languages iso3166-territories) "Run a page asking the user to select a locale language and possibly territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc available locales. ISO639-LANGUAGES is an association list associating a locale code to a locale name. ISO3166-TERRITORIES is an association list associating a territory code with a territory name. The formatted locale, under glibc format is returned." (define (break-on-locale-found locales) "Break to the installer step if LOCALES contains exactly one element." (and (= (length locales) 1) (abort-to-prompt '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 (sort-languages languages) "Extract some languages from LANGUAGES list and place them ahead." (let* ((first-languages '("en")) (other-languages (lset-difference equal? languages first-languages))) `(,@first-languages ,@other-languages))) (define locale-steps (list (installer-step (id 'language) (compute (lambda _ (run-language-page (sort-languages (delete-duplicates (map locale-language supported-locales))) (lambda (language) (let ((english (language-code->language-name iso639-languages language))) (setenv "LANGUAGE" language) (let ((native (gettext english "iso_639-3"))) (unsetenv "LANGUAGE") native))))))) (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) (if territory (let ((english (territory-code->territory-name iso3166-territories territory))) (gettext english "iso_3166-1")) (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, choose a codeset. (let ((codesets (delete-duplicates (map locale-codeset locales)))) (if (member "UTF-8" codesets) "UTF-8" ;don't even ask (run-codeset-page codesets))))))) (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 breaking to the installer ;; step, turn the result into a glibc locale string and return it. (result->locale-string supported-locales (run-installer-steps #:steps locale-steps)))