projects/guix·blob python-team · refs

95 lines · 3.5 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019 Ludovic Courtès <[email protected]>
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
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
26 normalize-codeset
27 locale->name+codeset
28 read-supported-locales))
29
30(define locale-rx
31 ;; Regexp matching a locale line in 'localedata/SUPPORTED'.
32 (make-regexp
33 "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$"))
34
35(define (read-supported-locales port)
36 "Read the 'localedata/SUPPORTED' file from PORT. That file is actually a
37makefile snippet, with one locale per line, and a header that can be
38discarded."
39 (let loop ((locales '()))
40 (define line
41 (read-line port))
42
43 (cond ((eof-object? line)
44 (reverse locales))
45 ((string-prefix? "#" (string-trim line)) ;comment
46 (loop locales))
47 ((string-contains line "=") ;makefile variable assignment
48 (loop locales))
49 (else
50 (match (regexp-exec locale-rx line)
51 (#f
52 (loop locales))
53 (m
54 (loop (alist-cons (match:substring m 1)
55 (match:substring m 2)
56 locales))))))))
57
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 ()
63 ((_ proc value)
64 (proc value))
65 ((_ proc rest ...)
66 (proc (-> rest ...))))))
67 (-> (lambda (str)
68 (if (string-every char-set:digit str)
69 (string-append "iso" str)
70 str))
71 string-downcase
72 (lambda (str)
73 (string-filter char-set:letter+digit str))
74 codeset)))
75
76(define* (build-locale locale
77 #:key
78 (localedef "localedef")
79 (directory ".")
80 (codeset "UTF-8")
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)))
88
89(define (locale->name+codeset locale)
90 "Split a locale name such as \"[email protected]\" into two values: the
91language/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))))))