You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

194 lines
7.1 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (gnu installer newt locale)
  19. #:use-module (gnu installer locale)
  20. #:use-module (gnu installer steps)
  21. #:use-module (gnu installer newt page)
  22. #:use-module (guix i18n)
  23. #:use-module (newt)
  24. #:use-module (srfi srfi-1)
  25. #:use-module (srfi srfi-26)
  26. #:use-module (srfi srfi-34)
  27. #:use-module (srfi srfi-35)
  28. #:use-module (ice-9 match)
  29. #:export (run-locale-page))
  30. (define (run-language-page languages language->text)
  31. (let ((title (G_ "Language selection")))
  32. (run-listbox-selection-page
  33. #:title title
  34. #:info-text (G_ "Choose the language to be used for the installation \
  35. process. The selected language will also be the default \
  36. language for the installed system.")
  37. #:listbox-items languages
  38. #:listbox-item->text language->text
  39. #:button-text (G_ "Cancel")
  40. #:button-callback-procedure
  41. (lambda _
  42. (raise
  43. (condition
  44. (&installer-step-abort)))))))
  45. (define (run-territory-page territories territory->text)
  46. (let ((title (G_ "Location selection")))
  47. (run-listbox-selection-page
  48. #:title title
  49. #:info-text (G_ "Choose your location. This is a shortlist of locations \
  50. based on the language you selected.")
  51. #:listbox-items territories
  52. #:listbox-item->text territory->text
  53. #:button-text (G_ "Back")
  54. #:button-callback-procedure
  55. (lambda _
  56. (raise
  57. (condition
  58. (&installer-step-abort)))))))
  59. (define (run-codeset-page codesets)
  60. (let ((title (G_ "Codeset selection")))
  61. (run-listbox-selection-page
  62. #:title title
  63. #:info-text (G_ "Choose your codeset. If UTF-8 is available, it should be \
  64. preferred.")
  65. #:listbox-items codesets
  66. #:listbox-item->text identity
  67. #:listbox-default-item "UTF-8"
  68. #:button-text (G_ "Back")
  69. #:button-callback-procedure
  70. (lambda _
  71. (raise
  72. (condition
  73. (&installer-step-abort)))))))
  74. (define (run-modifier-page modifiers modifier->text)
  75. (let ((title (G_ "Modifier selection")))
  76. (run-listbox-selection-page
  77. #:title title
  78. #:info-text (G_ "Choose your modifier.")
  79. #:listbox-items modifiers
  80. #:listbox-item->text modifier->text
  81. #:button-text (G_ "Back")
  82. #:button-callback-procedure
  83. (lambda _
  84. (raise
  85. (condition
  86. (&installer-step-abort)))))))
  87. (define* (run-locale-page #:key
  88. supported-locales
  89. iso639-languages
  90. iso3166-territories)
  91. (define (break-on-locale-found locales)
  92. "Raise the &installer-step-break condition if LOCALES contains exactly one
  93. element."
  94. (and (= (length locales) 1)
  95. (raise
  96. (condition (&installer-step-break)))))
  97. (define (filter-locales locales result)
  98. "Filter the list of locale records LOCALES using the RESULT returned by
  99. the installer-steps defined below."
  100. (filter
  101. (lambda (locale)
  102. (and-map identity
  103. `(,(string=? (locale-language locale)
  104. (result-step result 'language))
  105. ,@(if (result-step-done? result 'territory)
  106. (list (equal? (locale-territory locale)
  107. (result-step result 'territory)))
  108. '())
  109. ,@(if (result-step-done? result 'codeset)
  110. (list (equal? (locale-codeset locale)
  111. (result-step result 'codeset)))
  112. '())
  113. ,@(if (result-step-done? result 'modifier)
  114. (list (equal? (locale-modifier locale)
  115. (result-step result 'modifier)))
  116. '()))))
  117. locales))
  118. (define (result->locale-string locales result)
  119. "Supposing that LOCALES contains exactly one locale record, turn it into a
  120. glibc locale string and return it."
  121. (match (filter-locales locales result)
  122. ((locale)
  123. (locale->locale-string locale))))
  124. (define locale-steps
  125. (list
  126. (installer-step
  127. (id 'language)
  128. (compute
  129. (lambda _
  130. (run-language-page
  131. (delete-duplicates (map locale-language supported-locales))
  132. (cut language-code->language-name iso639-languages <>)))))
  133. (installer-step
  134. (id 'territory)
  135. (compute
  136. (lambda (result)
  137. (let ((locales (filter-locales supported-locales result)))
  138. ;; Stop the process if the language returned by the previous step
  139. ;; is matching one and only one supported locale.
  140. (break-on-locale-found locales)
  141. ;; Otherwise, ask the user to select a territory among those
  142. ;; supported by the previously selected language.
  143. (run-territory-page
  144. (delete-duplicates (map locale-territory locales))
  145. (lambda (territory-code)
  146. (if territory-code
  147. (territory-code->territory-name iso3166-territories
  148. territory-code)
  149. (G_ "No location"))))))))
  150. (installer-step
  151. (id 'codeset)
  152. (compute
  153. (lambda (result)
  154. (let ((locales (filter-locales supported-locales result)))
  155. ;; Same as above but we now have a language and a territory to
  156. ;; narrow down the search of a locale.
  157. (break-on-locale-found locales)
  158. ;; Otherwise, ask for a codeset.
  159. (run-codeset-page
  160. (delete-duplicates (map locale-codeset locales)))))))
  161. (installer-step
  162. (id 'modifier)
  163. (compute
  164. (lambda (result)
  165. (let ((locales (filter-locales supported-locales result)))
  166. ;; Same thing with a language, a territory and a codeset this time.
  167. (break-on-locale-found locales)
  168. ;; Otherwise, ask for a modifier.
  169. (run-modifier-page
  170. (delete-duplicates (map locale-modifier locales))
  171. (lambda (modifier)
  172. (or modifier (G_ "No modifier"))))))))))
  173. ;; If run-installer-steps returns locally, it means that the user had to go
  174. ;; through all steps (language, territory, codeset and modifier) to select a
  175. ;; locale. In that case, like if we exited by raising &installer-step-break
  176. ;; condition, turn the result into a glibc locale string and return it.
  177. (result->locale-string
  178. supported-locales
  179. (run-installer-steps #:steps locale-steps)))