;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu build locale) #:use-module (guix build utils) #:use-module (srfi srfi-1) #:use-module (ice-9 rdelim) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:export (build-locale normalize-codeset locale->name+codeset read-supported-locales)) (define locale-rx ;; Regexp matching a locale line in 'localedata/SUPPORTED'. (make-regexp "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$")) (define (read-supported-locales port) "Read the 'localedata/SUPPORTED' file from PORT. That file is actually a makefile snippet, with one locale per line, and a header that can be discarded." (let loop ((locales '())) (define line (read-line port)) (cond ((eof-object? line) (reverse locales)) ((string-prefix? "#" (string-trim line)) ;comment (loop locales)) ((string-contains line "=") ;makefile variable assignment (loop locales)) (else (match (regexp-exec locale-rx line) (#f (loop locales)) (m (loop (alist-cons (match:substring m 1) (match:substring m 2) locales)))))))) (define (normalize-codeset codeset) "Compute the \"normalized\" variant of CODESET." ;; info "(libc) Using gettextized software", for the algorithm used to ;; compute the normalized codeset. (letrec-syntax ((-> (syntax-rules () ((_ proc value) (proc value)) ((_ proc rest ...) (proc (-> rest ...)))))) (-> (lambda (str) (if (string-every char-set:digit str) (string-append "iso" str) str)) string-downcase (lambda (str) (string-filter char-set:letter+digit str)) codeset))) (define* (build-locale locale #:key (localedef "localedef") (directory ".") (codeset "UTF-8") (name (string-append locale "." codeset))) "Compute locale data for LOCALE and CODESET--e.g., \"en_US\" and \"UTF-8\"--with LOCALEDEF, and store it in DIRECTORY under NAME." (format #t "building locale '~a'...~%" name) (invoke localedef "--no-archive" "--prefix" directory "-i" locale "-f" codeset (string-append directory "/" name))) (define (locale->name+codeset locale) "Split a locale name such as \"aa_ER@saaho.UTF-8\" into two values: the language/territory/modifier part, and the codeset." (match (string-rindex locale #\.) (#f (values locale #f)) (dot (values (string-take locale dot) (string-drop locale (+ dot 1)))))) 2020-11-20image: Add pinebook-pro support....Mathieu Othacehe 2020-11-02ci: Restore license handling....Mathieu Othacehe 2020-11-02ci: Convert license to text....Mathieu Othacehe 2020-11-02ci: Ignore package license....Mathieu Othacehe 2020-10-06images: Add pine64-barebones-raw-image....Mathieu Othacehe 2020-10-01ci: Add log and outputs keys....Mathieu Othacehe 2020-10-01ci: Add nix-name and system keys....Mathieu Othacehe 2020-09-29ci: Build hurd-barebones-qcow2-image....Mathieu Othacehe 2020-09-25ci: Remove native-system restriction from "hello" and "list" jobsets....Jan (janneke) Nieuwenhuizen 2020-09-03ci: In the 'core' subset, build GCC >= 7....Ludovic Courtès 2020-09-03gnu: ci: Truncate git commit in ISO label....Julien Lepiller 2020-08-31gnu: ci: Set label in iso9660 jobs....Julien Lepiller