locale.scm 7.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
  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 system locale)
  19. #:use-module (guix gexp)
  20. #:use-module (guix store)
  21. #:use-module (guix records)
  22. #:use-module (guix packages)
  23. #:use-module (gnu packages base)
  24. #:use-module (gnu packages compression)
  25. #:use-module (srfi srfi-26)
  26. #:use-module (ice-9 match)
  27. #:export (locale-definition
  28. locale-definition?
  29. locale-definition-name
  30. locale-definition-source
  31. locale-definition-charset
  32. locale-name->definition
  33. locale-directory
  34. %default-locale-libcs
  35. %default-locale-definitions))
  36. ;;; Commentary:
  37. ;;;
  38. ;;; Locale definitions, and compilation thereof.
  39. ;;;
  40. ;;; Code:
  41. (define-record-type* <locale-definition> locale-definition
  42. make-locale-definition
  43. locale-definition?
  44. (name locale-definition-name) ;string--e.g., "fr_FR.utf8"
  45. (source locale-definition-source) ;string--e.g., "fr_FR"
  46. (charset locale-definition-charset ;string--e.g., "UTF-8"
  47. (default "UTF-8")))
  48. (define %not-dot
  49. (char-set-complement (char-set #\.)))
  50. (define (denormalize-codeset codeset)
  51. "Attempt to guess the \"real\" name of CODESET, a normalized codeset as
  52. defined in (info \"(libc) Using gettextized software\")."
  53. (cond ((string=? codeset "utf8")
  54. "UTF-8")
  55. ((string-prefix? "iso8859" codeset)
  56. (string-append "ISO-8859-" (string-drop codeset 7)))
  57. ((string=? codeset "eucjp")
  58. "EUC-JP")
  59. (else ;cross fingers, hope for the best
  60. codeset)))
  61. (define (locale-name->definition name)
  62. "Return a <locale-definition> corresponding to NAME, guessing the charset,
  63. or #f on failure."
  64. (match (string-tokenize name %not-dot)
  65. ((source charset)
  66. ;; XXX: NAME is supposed to use the "normalized codeset", such as "utf8",
  67. ;; whereas the actual name used is different. Add a special case to make
  68. ;; the right guess for UTF-8.
  69. (locale-definition (name name)
  70. (source source)
  71. (charset (denormalize-codeset charset))))
  72. (_
  73. #f)))
  74. (define* (localedef-command locale
  75. #:key (libc (canonical-package glibc)))
  76. "Return a gexp that runs 'localedef' from LIBC to build LOCALE."
  77. #~(begin
  78. (format #t "building locale '~a'...~%"
  79. #$(locale-definition-name locale))
  80. (zero? (system* (string-append #+libc "/bin/localedef")
  81. "--no-archive" "--prefix" #$output
  82. "-i" #$(locale-definition-source locale)
  83. "-f" #$(locale-definition-charset locale)
  84. (string-append #$output "/"
  85. #$(package-version libc) "/"
  86. #$(locale-definition-name locale))))))
  87. (define* (single-locale-directory locales
  88. #:key (libc (canonical-package glibc)))
  89. "Return a directory containing all of LOCALES for LIBC compiled.
  90. Because locale data formats are incompatible when switching from one libc to
  91. another, locale data is put in a sub-directory named after the 'version' field
  92. of LIBC."
  93. (define version
  94. (package-version libc))
  95. (define build
  96. #~(begin
  97. (mkdir #$output)
  98. (mkdir (string-append #$output "/" #$version))
  99. ;; 'localedef' executes 'gzip' to access compressed locale sources.
  100. (setenv "PATH" (string-append #$gzip "/bin"))
  101. (exit
  102. (and #$@(map (cut localedef-command <> #:libc libc)
  103. locales)))))
  104. (computed-file (string-append "locale-" version) build))
  105. (define* (locale-directory locales
  106. #:key (libcs %default-locale-libcs))
  107. "Return a locale directory containing all of LOCALES for each libc package
  108. listed in LIBCS.
  109. It is useful to list more than one libc when willing to support
  110. already-installed packages built against a different libc since the locale
  111. data format changes between libc versions."
  112. (match libcs
  113. ((libc)
  114. (single-locale-directory locales #:libc libc))
  115. ((libcs ..1)
  116. (let ((dirs (map (lambda (libc)
  117. (single-locale-directory locales #:libc libc))
  118. libcs)))
  119. (computed-file "locale-multiple-versions"
  120. (with-imported-modules '((guix build union))
  121. #~(begin
  122. (use-modules (guix build union))
  123. (union-build #$output (list #$@dirs))))
  124. #:options '(#:local-build? #t
  125. #:substitutable? #f))))))
  126. (define %default-locale-libcs
  127. ;; The libcs for which we build locales by default.
  128. (list (canonical-package glibc)))
  129. (define %default-locale-definitions
  130. ;; Arbitrary set of locales that are built by default. They are here mostly
  131. ;; to facilitate first-time use to some people, while others may have to add
  132. ;; a specific <locale-definition>.
  133. (letrec-syntax ((utf8-locale (syntax-rules ()
  134. ((_ name*)
  135. (locale-definition
  136. ;; Note: We choose "utf8", which is the
  137. ;; "normalized codeset".
  138. (name (string-append name* ".utf8"))
  139. (source name*)
  140. (charset "UTF-8")))))
  141. (utf8-locales (syntax-rules ()
  142. ((_ name ...)
  143. (list (utf8-locale name) ...)))))
  144. ;; Add "en_US.UTF-8" for compatibility with Guix 0.8.
  145. (cons (locale-definition
  146. (name "en_US.UTF-8")
  147. (source "en_US")
  148. (charset "UTF-8"))
  149. (utf8-locales "ca_ES"
  150. "cs_CZ"
  151. "da_DK"
  152. "de_DE"
  153. "el_GR"
  154. "en_AU"
  155. "en_CA"
  156. "en_GB"
  157. "en_US"
  158. "es_AR"
  159. "es_CL"
  160. "es_ES"
  161. "es_MX"
  162. "fi_FI"
  163. "fr_BE"
  164. "fr_CA"
  165. "fr_CH"
  166. "fr_FR"
  167. "ga_IE"
  168. "it_IT"
  169. "ja_JP"
  170. "ko_KR"
  171. "nb_NO"
  172. "nl_NL"
  173. "pl_PL"
  174. "pt_PT"
  175. "ro_RO"
  176. "ru_RU"
  177. "sv_SE"
  178. "tr_TR"
  179. "uk_UA"
  180. "vi_VN"
  181. "zh_CN"))))
  182. ;;; locale.scm ends here