blob: 86bf350a5f1dc7ce50e2e97d924fd7dc59e89c2b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
;;; Harmonic Flow web site
(define-module (apps i18n)
#:use-module (haunt asset)
#:use-module (haunt artifact)
#:use-module (haunt utils)
#:use-module ((guix i18n) #:select (%package-text-domain))
#:use-module (ice-9 match)
#:use-module (sexp-xgettext)
#:use-module (srfi srfi-1)
#:export (G_
N_
C_
NC_
%current-ietf-tag
%current-lang
%current-lingua
builder->localized-builder
builders->localized-builders
ietf-tags-file-contents
localized-root-path))
(define %gettext-domain
"guix-website")
(bindtextdomain %gettext-domain (getcwd))
(bind-textdomain-codeset %gettext-domain "UTF-8")
(textdomain %gettext-domain)
(bindtextdomain %package-text-domain (getcwd))
(bind-textdomain-codeset %package-text-domain "UTF-8")
;; NOTE: The sgettext macros have no hygiene because they use
;; datum->syntax and do not preserve the semantics of anything looking
;; like an sgettext macro. This is an exceptional use case; do not
;; try this at home.
(define-syntax G_
sgettext)
(set-simple-keywords! '(G_))
(define-syntax N_ ;like ngettext
sngettext)
(define-syntax C_ ;like pgettext
spgettext)
(define-syntax NC_ ;like npgettext
snpgettext)
(set-complex-keywords! '(N_ C_ NC_))
(define %current-lingua
;; strip the character encoding:
(car (string-split (setlocale LC_ALL) #\.)))
(define-syntax ietf-tags-file-contents
(identifier-syntax
(force (delay (call-with-input-file
"po/ietf-tags.scm"
(lambda (port) (read port)))))))
(define %current-ietf-tag
(or (assoc-ref ietf-tags-file-contents %current-lingua)
"en"))
(define %current-lang
(car (string-split %current-ietf-tag #\-)))
(define* (localized-root-path url #:key (lingua %current-ietf-tag))
"Given a URL as used in a href attribute, return the URL prefix
'builder->localized-builder' would use for the URL when called with
LINGUA."
(if (or (string-suffix? ".html" url)
(string-suffix? "/" url))
(string-append lingua "/")
""))
(define (first-value arg)
"For some reason the builder returned by static-directory returns
multiple values. This procedure is used to retain only the first
return value. TODO: This should not be necessary."
arg)
(define (builder->localized-builder builder)
"Return a Haunt builder procedure generated from an existing BUILDER
with translations for the current system locale coming from
sexp-xgettext."
(compose
(lambda (pages-and-assets)
(map (match-lambda
((? artifact? artifact) ;Haunt >= 0.2.5
(let ((new-name (string-append
(localized-root-path (artifact-file-name artifact))
(artifact-file-name artifact))))
(make-artifact new-name
(artifact-writer artifact)))))
pages-and-assets))
(lambda (site posts)
(first-value (builder site posts)))))
(define (builders->localized-builders builders)
"Return a list of new Haunt builder procedures generated from
BUILDERS and localized via sexp-xgettext for the current system
locale."
(flatten
(map-in-order
builder->localized-builder
builders)))
|
