diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-06-06 13:36:51 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-06-07 21:50:18 +0200 |
| commit | 15ec93a7832ae7dde747ccd9bb2bb2776be9f199 (patch) | |
| tree | c6b97d333950ec8ad734624244586cb60ca7e47d /gnu | |
| parent | bc48088b14a4513044f87ce656db6945311c40d6 (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.scm | 86 | ||||
| -rw-r--r-- | gnu/installer/locale.scm | 19 | ||||
| -rw-r--r-- | gnu/local.mk | 1 | ||||
| -rw-r--r-- | gnu/system/locale.scm | 83 |
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 | ||
| 36 | makefile snippet, with one locale per line, and a header that can be | ||
| 37 | discarded." | ||
| 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. |
| 641 | MODULES_NOT_COMPILED += \ | 641 | MODULES_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 | |||
| 216 | locale supported by GLIBC." | 214 | locale 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") ":" |
