summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-06-06 13:36:51 +0200
committerLudovic Courtès <ludo@gnu.org>2019-06-07 21:50:18 +0200
commit15ec93a7832ae7dde747ccd9bb2bb2776be9f199 (patch)
treec6b97d333950ec8ad734624244586cb60ca7e47d /gnu
parentbc48088b14a4513044f87ce656db6945311c40d6 (diff)
Add (gnu build locale).
* gnu/build/locale.scm: New file. * gnu/local.mk (MODULES_NOT_COMPILED): Add it. * gnu/installer/locale.scm (normalize-codeset): Remove. * gnu/system/locale.scm (localedef-command): Remove. (single-locale-directory): Use (gnu build locale). (glibc-supported-locales)[build]: Likewise, and remove 'read-supported-locales'.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/build/locale.scm86
-rw-r--r--gnu/installer/locale.scm19
-rw-r--r--gnu/local.mk1
-rw-r--r--gnu/system/locale.scm83
4 files changed, 114 insertions, 75 deletions
diff --git a/gnu/build/locale.scm b/gnu/build/locale.scm
new file mode 100644
index 00000000000..c75a2e9dc57
--- /dev/null
+++ b/gnu/build/locale.scm
@@ -0,0 +1,86 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019 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
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 read-supported-locales))
28
29(define locale-rx
30 ;; Regexp matching a locale line in 'localedata/SUPPORTED'.
31 (make-regexp
32 "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$"))
33
34(define (read-supported-locales port)
35 "Read the 'localedata/SUPPORTED' file from PORT. That file is actually a
36makefile snippet, with one locale per line, and a header that can be
37discarded."
38 (let loop ((locales '()))
39 (define line
40 (read-line port))
41
42 (cond ((eof-object? line)
43 (reverse locales))
44 ((string-prefix? "#" (string-trim line)) ;comment
45 (loop locales))
46 ((string-contains line "=") ;makefile variable assignment
47 (loop locales))
48 (else
49 (match (regexp-exec locale-rx line)
50 (#f
51 (loop locales))
52 (m
53 (loop (alist-cons (match:substring m 1)
54 (match:substring m 2)
55 locales))))))))
56
57(define (normalize-codeset codeset)
58 "Compute the \"normalized\" variant of CODESET."
59 ;; info "(libc) Using gettextized software", for the algorithm used to
60 ;; compute the normalized codeset.
61 (letrec-syntax ((-> (syntax-rules ()
62 ((_ proc value)
63 (proc value))
64 ((_ proc rest ...)
65 (proc (-> rest ...))))))
66 (-> (lambda (str)
67 (if (string-every char-set:digit str)
68 (string-append "iso" str)
69 str))
70 string-downcase
71 (lambda (str)
72 (string-filter char-set:letter+digit str))
73 codeset)))
74
75(define* (build-locale locale
76 #:key
77 (localedef "localedef")
78 (directory ".")
79 (codeset "UTF-8")
80 (name (string-append locale "." codeset)))
81 "Compute locale data for LOCALE and CODESET--e.g., \"en_US\" and
82\"UTF-8\"--with LOCALEDEF, and store it in DIRECTORY under NAME."
83 (format #t "building locale '~a'...~%" name)
84 (invoke localedef "--no-archive" "--prefix" directory
85 "-i" locale "-f" codeset
86 (string-append directory "/" name)))
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
index 2ee5eecd96f..13f3a1e881c 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.scm
@@ -19,6 +19,7 @@
19 19
20(define-module (gnu installer locale) 20(define-module (gnu installer locale)
21 #:use-module (gnu installer utils) 21 #:use-module (gnu installer utils)
22 #:use-module ((gnu build locale) #:select (normalize-codeset))
22 #:use-module (guix records) 23 #:use-module (guix records)
23 #:use-module (json) 24 #:use-module (json)
24 #:use-module (srfi srfi-1) 25 #:use-module (srfi srfi-1)
@@ -71,24 +72,6 @@ optionally, CODESET."
71 (codeset . ,(or codeset (match:substring matches 5))) 72 (codeset . ,(or codeset (match:substring matches 5)))
72 (modifier . ,(match:substring matches 7))))) 73 (modifier . ,(match:substring matches 7)))))
73 74
74(define (normalize-codeset codeset)
75 "Compute the \"normalized\" variant of CODESET."
76 ;; info "(libc) Using gettextized software", for the algorithm used to
77 ;; compute the normalized codeset.
78 (letrec-syntax ((-> (syntax-rules ()
79 ((_ proc value)
80 (proc value))
81 ((_ proc rest ...)
82 (proc (-> rest ...))))))
83 (-> (lambda (str)
84 (if (string-every char-set:digit str)
85 (string-append "iso" str)
86 str))
87 string-downcase
88 (lambda (str)
89 (string-filter char-set:letter+digit str))
90 codeset)))
91
92(define (locale->locale-string locale) 75(define (locale->locale-string locale)
93 "Reverse operation of locale-string->locale." 76 "Reverse operation of locale-string->locale."
94 (let ((language (locale-language locale)) 77 (let ((language (locale-language locale))
diff --git a/gnu/local.mk b/gnu/local.mk
index 98f6ee9679c..05221483851 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -639,6 +639,7 @@ dist_installer_DATA = \
639 639
640# Modules that do not need to be compiled. 640# Modules that do not need to be compiled.
641MODULES_NOT_COMPILED += \ 641MODULES_NOT_COMPILED += \
642 %D%/build/locale.scm \
642 %D%/build/shepherd.scm \ 643 %D%/build/shepherd.scm \
643 %D%/build/svg.scm 644 %D%/build/svg.scm
644 645
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 533a45e1496..8466d5b07d9 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -85,20 +85,6 @@ or #f on failure."
85 (_ 85 (_
86 #f))) 86 #f)))
87 87
88(define* (localedef-command locale
89 #:key (libc (canonical-package glibc)))
90 "Return a gexp that runs 'localedef' from LIBC to build LOCALE."
91 #~(begin
92 (format #t "building locale '~a'...~%"
93 #$(locale-definition-name locale))
94 (zero? (system* (string-append #+libc "/bin/localedef")
95 "--no-archive" "--prefix" #$output
96 "-i" #$(locale-definition-source locale)
97 "-f" #$(locale-definition-charset locale)
98 (string-append #$output "/" #$(version-major+minor
99 (package-version libc))
100 "/" #$(locale-definition-name locale))))))
101
102(define* (single-locale-directory locales 88(define* (single-locale-directory locales
103 #:key (libc (canonical-package glibc))) 89 #:key (libc (canonical-package glibc)))
104 "Return a directory containing all of LOCALES for LIBC compiled. 90 "Return a directory containing all of LOCALES for LIBC compiled.
@@ -110,17 +96,29 @@ of LIBC."
110 (version-major+minor (package-version libc))) 96 (version-major+minor (package-version libc)))
111 97
112 (define build 98 (define build
113 #~(begin 99 (with-imported-modules (source-module-closure
114 (mkdir #$output) 100 '((gnu build locale)))
115 101 #~(begin
116 (mkdir (string-append #$output "/" #$version)) 102 (use-modules (gnu build locale))
117 103
118 ;; 'localedef' executes 'gzip' to access compressed locale sources. 104 (mkdir #$output)
119 (setenv "PATH" (string-append #$gzip "/bin")) 105 (mkdir (string-append #$output "/" #$version))
120 106
121 (exit 107 ;; 'localedef' executes 'gzip' to access compressed locale sources.
122 (and #$@(map (cut localedef-command <> #:libc libc) 108 (setenv "PATH"
123 locales))))) 109 (string-append #$gzip "/bin:" #$libc "/bin"))
110
111 (setvbuf (current-output-port) 'line)
112 (setvbuf (current-error-port) 'line)
113 (for-each (lambda (locale codeset name)
114 (build-locale locale
115 #:codeset codeset
116 #:name name
117 #:directory
118 (string-append #$output "/" #$version)))
119 '#$(map locale-definition-source locales)
120 '#$(map locale-definition-charset locales)
121 '#$(map locale-definition-name locales)))))
124 122
125 (computed-file (string-append "locale-" version) build)) 123 (computed-file (string-append "locale-" version) build))
126 124
@@ -216,45 +214,16 @@ pairs such as (\"oc_FR.UTF-8\" . \"UTF-8\"). Each pair corresponds to a
216locale supported by GLIBC." 214locale supported by GLIBC."
217 (define build 215 (define build
218 (with-imported-modules (source-module-closure 216 (with-imported-modules (source-module-closure
219 '((guix build gnu-build-system))) 217 '((guix build gnu-build-system)
218 (gnu build locale)))
220 #~(begin 219 #~(begin
221 (use-modules (guix build gnu-build-system) 220 (use-modules (guix build gnu-build-system)
222 (srfi srfi-1) 221 (gnu build locale)
223 (ice-9 rdelim)
224 (ice-9 match)
225 (ice-9 regex)
226 (ice-9 pretty-print)) 222 (ice-9 pretty-print))
227 223
228 (define unpack 224 (define unpack
229 (assq-ref %standard-phases 'unpack)) 225 (assq-ref %standard-phases 'unpack))
230 226
231 (define locale-rx
232 ;; Regexp matching a locale line in 'localedata/SUPPORTED'.
233 (make-regexp
234 "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$"))
235
236 (define (read-supported-locales port)
237 ;; Read the 'localedata/SUPPORTED' file from PORT. That file is
238 ;; actually a makefile snippet, with one locale per line, and a
239 ;; header that can be discarded.
240 (let loop ((locales '()))
241 (define line
242 (read-line port))
243
244 (cond ((eof-object? line)
245 (reverse locales))
246 ((string-prefix? "#" (string-trim line)) ;comment
247 (loop locales))
248 ((string-contains line "=") ;makefile variable assignment
249 (loop locales))
250 (else
251 (match (regexp-exec locale-rx line)
252 (#f
253 (loop locales))
254 (m
255 (loop (alist-cons (match:substring m 1)
256 (match:substring m 2)
257 locales))))))))
258 227
259 (setenv "PATH" 228 (setenv "PATH"
260 (string-append #+(file-append tar "/bin") ":" 229 (string-append #+(file-append tar "/bin") ":"