1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
19 (define-module (gnu build locale)
20 #:use-module (guix build utils)
21 #:use-module (srfi srfi-1)
22 #:use-module (ice-9 rdelim)
23 #:use-module (ice-9 match)
24 #:use-module (ice-9 regex)
25 #:export (build-locale
28 read-supported-locales))
31 ;; Regexp matching a locale line in 'localedata/SUPPORTED'.
33 "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$"))
35 (define (read-supported-locales port)
36 "Read the 'localedata/SUPPORTED' file from PORT. That file is actually a
37 makefile snippet, with one locale per line, and a header that can be
39 (let loop ((locales '()))
43 (cond ((eof-object? line)
45 ((string-prefix? "#" (string-trim line)) ;comment
47 ((string-contains line "=") ;makefile variable assignment
50 (match (regexp-exec locale-rx line)
54 (loop (alist-cons (match:substring m 1)
58 (define (normalize-codeset codeset)
59 "Compute the \"normalized\" variant of CODESET."
60 ;; info "(libc) Using gettextized software", for the algorithm used to
61 ;; compute the normalized codeset.
62 (letrec-syntax ((-> (syntax-rules ()
66 (proc (-> rest ...))))))
68 (if (string-every char-set:digit str)
69 (string-append "iso" str)
73 (string-filter char-set:letter+digit str))
76 (define* (build-locale locale
78 (localedef "localedef")
81 (name (string-append locale "." codeset)))
82 "Compute locale data for LOCALE and CODESET--e.g., \"en_US\" and
83 \"UTF-8\"--with LOCALEDEF, and store it in DIRECTORY under NAME."
84 (format #t "building locale '~a'...~%" name)
85 (invoke localedef "--no-archive" "--prefix" directory
86 "-i" locale "-f" codeset
87 (string-append directory "/" name)))
89 (define (locale->name+codeset locale)
90 "Split a locale name such as \"aa_ER@saaho.UTF-8\" into two values: the
91 language/territory/modifier part, and the codeset."
92 (match (string-rindex locale #\.)
93 (#f (values locale #f))
94 (dot (values (string-take locale dot)
95 (string-drop locale (+ dot 1))))))