Re: Guix beyond 1.0: let’s have a roadmap!

Re: Guix beyond 1.0: let’s have a roadmap!

[matias_jose_seco]

I dream to reach a (digital) place, where a Guix Logo brights in the 
center of the door (intro web page), and scattered all around it, 
signposts (Links) of all imaginable languages, broadcast "Welcome" 
(Bienvenido, Nnabata, أهلا بك, 歡迎, добро пожаловать, ...).


Singular is, many digital adventurers are exploring places which uses 
their own language [1].
This wish is interestingly expressed by the Localization Lab [2],
which introduces technological terms within unrepresented languages, for 
Projects which, i feel, follows the GNU spirit [3].


1: 
https://www.localizationlab.org/blog/2019/3/7/hl8xdh6nacw5bpe5v4skhjkv0smeda
2: https://www.localizationlab.org/about-us
3: https://www.localizationlab.org/projects-1

PS: I was wondering, which is the actual feeling to traverse the Gnunet 
and Fediverse cosmos ?

Have a nice journey, Matias :)

Re: Guix beyond 1.0: let’s have a roadmap!

[Ludovic Courtès]

Hi,

matias_jose_seco@autoproduzioni.net skribis:

> I dream to reach a (digital) place, where a Guix Logo brights in the
> center of the door (intro web page), and scattered all around it,
> signposts (Links) of all imaginable languages, broadcast "Welcome"
> (Bienvenido, Nnabata, أهلا بك, 歡迎, добро пожаловать, ...).
>
>
> Singular is, many digital adventurers are exploring places which uses
> their own language [1].
> This wish is interestingly expressed by the Localization Lab [2],
> which introduces technological terms within unrepresented languages,
> for Projects which, i feel, follows the GNU spirit [3].

Thanks for bringing this up.  I’m very much convinced this is an
important task, and I’m happy there’s already a team of dedicated
volunteers who’ve worked hard translating the manual and messages!

The next obvious step is to translate the web site.  There were open
questions as to how to do it, but I think Julien and Florian had more or
less found a way forward, so I hope we can work on it soonish.

Thanks,
Ludo’.

Website translation (was: Re: Guix beyond 1.0: let’s have a roadmap!)

[pelzflorian (Florian Pelz)]

On Sun, Jul 07, 2019 at 04:20:59PM +0200, Ludovic Courtès wrote:
> Thanks for bringing this up.  I’m very much convinced this is an
> important task, and I’m happy there’s already a team of dedicated
> volunteers who’ve worked hard translating the manual and messages!
>

Yes. :)

> The next obvious step is to translate the web site.  There were open
> questions as to how to do it, but I think Julien and Florian had more or
> less found a way forward, so I hope we can work on it soonish.
> 

The method I use is the _ macro at
<https://pelzflorian.de/git/pelzfloriande-website/tree/haunt.scm>
(Guix sensibly would call such a macro G_).  It simply calls setlocale
once for each string that needs to be translated.

This has better runtime performance than using libgettextpo via nyacc
unless there are a very great number of strings.

The best performance could be gained by reading the compiled MO file
directly, but then Guile code would need to be written for reading MO
files, also performance does not matter that much when building a
static website.


Ricardo Wurmus thankfully recommended using sxpath for formatting, see
what I called __ in my code.


Note that many improvements could be made in my code,
e.g. current-lingua could be a parameter, so (I hope) it can be
avoided to change various parts of Haunt to accept procedures like
(lambda (current-lingua) …) instead of plain sxml/shtml like I did.

Regards,
Florian

Re: Website translation (was: Re: Guix beyond 1.0: let’s have a roadmap!)

[pelzflorian (Florian Pelz)]

On Sun, Jul 07, 2019 at 06:57:22PM +0200, pelzflorian (Florian Pelz) wrote:
> Note that many improvements could be made in my code,
> e.g. current-lingua could be a parameter, so (I hope) it can be
> avoided to change various parts of Haunt to accept procedures like
> (lambda (current-lingua) …) instead of plain sxml/shtml like I did.
>

When I said the current-lingua could be a parameter then I mean what
the Guile manual calls parameter object, i.e. “Guile’s facility for
dynamically bound variables”.  Maybe you would use a fluid or
something.  I am not familiar with these things.

Re: Website translation (was: Re: Guix beyond 1.0: let’s have a roadmap!)

[Christopher Lemmer Webber]

pelzflorian (Florian Pelz) writes:

> On Sun, Jul 07, 2019 at 04:20:59PM +0200, Ludovic Courtès wrote:
>> Thanks for bringing this up.  I’m very much convinced this is an
>> important task, and I’m happy there’s already a team of dedicated
>> volunteers who’ve worked hard translating the manual and messages!
>>
>
> Yes. :)
>
>> The next obvious step is to translate the web site.  There were open
>> questions as to how to do it, but I think Julien and Florian had more or
>> less found a way forward, so I hope we can work on it soonish.
>> 
>
> The method I use is the _ macro at
> <https://pelzflorian.de/git/pelzfloriande-website/tree/haunt.scm>
> (Guix sensibly would call such a macro G_).  It simply calls setlocale
> once for each string that needs to be translated.

Maybe see also the conversation about a i18n quasiquote here:

https://lists.gnu.org/archive/html/guile-user/2017-12/msg00050.html

Re: Website translation

[Ludovic Courtès]

Hello,

Christopher Lemmer Webber <cwebber@dustycloud.org> skribis:

> pelzflorian (Florian Pelz) writes:
>
>> On Sun, Jul 07, 2019 at 04:20:59PM +0200, Ludovic Courtès wrote:
>>> Thanks for bringing this up.  I’m very much convinced this is an
>>> important task, and I’m happy there’s already a team of dedicated
>>> volunteers who’ve worked hard translating the manual and messages!
>>>
>>
>> Yes. :)
>>
>>> The next obvious step is to translate the web site.  There were open
>>> questions as to how to do it, but I think Julien and Florian had more or
>>> less found a way forward, so I hope we can work on it soonish.
>>> 
>>
>> The method I use is the _ macro at
>> <https://pelzflorian.de/git/pelzfloriande-website/tree/haunt.scm>
>> (Guix sensibly would call such a macro G_).  It simply calls setlocale
>> once for each string that needs to be translated.
>
> Maybe see also the conversation about a i18n quasiquote here:
>
> https://lists.gnu.org/archive/html/guile-user/2017-12/msg00050.html

Ah yes, I believe the issue you raised in that message (“lego
translations”) is not addressed by Florian’s approach.

However, the #_ form you propose doesn’t quite work either because
xgettext in its current form wouldn’t be able to extract it.

sirgazil proposed a solution that’s similar to format strings to address
that:

  https://lists.gnu.org/archive/html/guile-user/2017-12/msg00071.html

Worth a try!

Thanks,
Ludo’.

Re: Website translation

[pelzflorian (Florian Pelz)]

On Thu, Jul 11, 2019 at 05:15:11PM +0200, Ludovic Courtès wrote:
> Ah yes, I believe the issue you raised in that message (“lego
> translations”) is not addressed by Florian’s approach.
> 
> However, the #_ form you propose doesn’t quite work either because
> xgettext in its current form wouldn’t be able to extract it.
> 
> sirgazil proposed a solution that’s similar to format strings to address
> that:
> 
>   https://lists.gnu.org/archive/html/guile-user/2017-12/msg00071.html
> 
> Worth a try!
> 

So:

1) We could put everything in a single string, which works with
xgettext and is somewhat easy to use for translators but not quite
Scheme-like.

2) We could use something like sirgazil’s format string solution.  It
works with xgettext, but is not nice for translators.

I wrote in <https://lists.gnu.org/archive/html/guile-user/2017-12/msg00069.html>:
> This interleaving is like a format string and is common in
> applications, but it separates the value of ~SPORT~ from the context
> in which it should be translated.

3) We could write our own PO file writer and MO file reader and use it
with either Christopher’s lego translation and sirgazil’s format
strings to use whatever format we want for developers and translators.

sirgazil’s format strings could probably be used now and improved with
a custom PO/MO reader/writer later on.

The MO file format is well documented at
<https://www.gnu.org/s/gettext/manual/html_node/MO-Files.html#MO-Files>
but “it is expectable that MO file format will evolve or change over
time”.

Such a custom reader/writer could be part of Gettext or could be a
separate library.  I am not going to write it though.

Regards,
Florian

Re: Website translation

[Ludovic Courtès]

Hi,

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:

> 3) We could write our own PO file writer and MO file reader and use it
> with either Christopher’s lego translation and sirgazil’s format
> strings to use whatever format we want for developers and translators.

Note that “lego translation” is what we should _not_ do because it gives
translators fragments of sentences, which does not allow them to
correctly translate text.

As long as we use xgettext, we have to stick to a format-string-like
approach like what sirgazil proposes.

Writing a custom xgettext kind of tool wouldn’t help much because
gettext is fundamentally text oriented: you give it a string and it
returns a string.

So I think the alternative is:

  • use gettext, and in that case stick to a format-string-like
    mechanism, or:

  • use a completely new tool that would be able to consume and produce
    sexps (trees).

The latter doesn’t seem reasonable to me.  :-)

BTW, there might also be ideas to borrow from GNUN:

  https://www.gnu.org/software/gnun/

Thanks,
Ludo’.

Re: Website translation

[pelzflorian (Florian Pelz)]

On Sun, Jul 14, 2019 at 04:12:41PM +0200, Ludovic Courtès wrote:
> Note that “lego translation” is what we should _not_ do because it gives
> translators fragments of sentences, which does not allow them to
> correctly translate text.
>

Format strings are something we can try.  If they are too fragmented
for translators, we can still use a custom tool to convert them and
their fragments to a single string which gets passed to gettext.

Regards,
Florian

Re: Website translation

[Ludovic Courtès]

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:

> On Sun, Jul 14, 2019 at 04:12:41PM +0200, Ludovic Courtès wrote:
>> Note that “lego translation” is what we should _not_ do because it gives
>> translators fragments of sentences, which does not allow them to
>> correctly translate text.
>>
>
> Format strings are something we can try.  If they are too fragmented
> for translators, we can still use a custom tool to convert them and
> their fragments to a single string which gets passed to gettext.

Yes.

Another option would be to locally use XML in strings, along these
lines:

--8<---------------cut here---------------start------------->8---
(use-modules (sxml simple)
             (ice-9 match))

(define (X_ str)
  (match (xml->sxml (string-append "<BODY>"
                                   (gettext str)
                                   "</BODY>"))
    (('*TOP* ('BODY . lst)) lst)))

`(div
   ,@(X_ "This is <a href=\"/foo\">a link</a>."))
--8<---------------cut here---------------end--------------->8---

That would allow us to remain string-oriented while still enjoying the
benefits of SXML (info "(guile) Types and the Web").

Maybe we’ll need a combination of format strings and stuff like that.

Thanks,
Ludo’.

Re: Website translation

[Julien Lepiller]

Le 15 juillet 2019 14:33:25 GMT+02:00, "Ludovic Courtès" <ludo@gnu.org> a écrit :
>"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:
>
>> On Sun, Jul 14, 2019 at 04:12:41PM +0200, Ludovic Courtès wrote:
>>> Note that “lego translation” is what we should _not_ do because it
>gives
>>> translators fragments of sentences, which does not allow them to
>>> correctly translate text.
>>>
>>
>> Format strings are something we can try.  If they are too fragmented
>> for translators, we can still use a custom tool to convert them and
>> their fragments to a single string which gets passed to gettext.
>
>Yes.
>
>Another option would be to locally use XML in strings, along these
>lines:
>
>--8<---------------cut here---------------start------------->8---
>(use-modules (sxml simple)
>             (ice-9 match))
>
>(define (X_ str)
>  (match (xml->sxml (string-append "<BODY>"
>                                   (gettext str)
>                                   "</BODY>"))
>    (('*TOP* ('BODY . lst)) lst)))
>
>`(div
>   ,@(X_ "This is <a href=\"/foo\">a link</a>."))
>--8<---------------cut here---------------end--------------->8---
>
>That would allow us to remain string-oriented while still enjoying the
>benefits of SXML (info "(guile) Types and the Web").
>
>Maybe we’ll need a combination of format strings and stuff like that.
>
>Thanks,
>Ludo’.

Fyi, I sent a patch a few months ago to do exactly that, but I can't find it anymore…

Re: Website translation

[pelzflorian (Florian Pelz)]

On Mon, Jul 15, 2019 at 02:33:25PM +0200, Ludovic Courtès wrote:
> `(div
>    ,@(X_ "This is <a href=\"/foo\">a link</a>."))

For such things I prefer XML like Ricardo proposed
<https://lists.gnu.org/archive/html/guix-devel/2018-02/msg00114.html>
or like the __ on my
<https://pelzflorian.de/git/pelzfloriande-website/tree/> rather than
cryptic HTML a elements and href.

However, this would again look even nicer when passing sexps to a
custom tool that converts them to a string that can get used with a
custom PO file writer or MO reader, wouldn’t it?

Should Guix just try with format strings for now?

Regards,
Florian

Re: Website translation

[Ludovic Courtès]

Hi,

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:

> On Mon, Jul 15, 2019 at 02:33:25PM +0200, Ludovic Courtès wrote:
>> `(div
>>    ,@(X_ "This is <a href=\"/foo\">a link</a>."))
>
> For such things I prefer XML like Ricardo proposed
> <https://lists.gnu.org/archive/html/guix-devel/2018-02/msg00114.html>

Indeed, I agree.

> or like the __ on my
> <https://pelzflorian.de/git/pelzfloriande-website/tree/> rather than
> cryptic HTML a elements and href.
>
> However, this would again look even nicer when passing sexps to a
> custom tool that converts them to a string that can get used with a
> custom PO file writer or MO reader, wouldn’t it?
>
> Should Guix just try with format strings for now?

I think we now have an overview of the possibilities (including maybe
‘itstool’ that Ricardo mentions.)  I’d say that whoever is interested
should give it a try with what looks like the most promising approach
and report back with a prototype.  :-)

Thanks,
Ludo’.

Re: Website translation

[pelzflorian (Florian Pelz)]

[-- Attachment #1: Type: text/plain, Size: 1159 bytes --]

On Wed, Jul 17, 2019 at 11:16:21PM +0200, Ludovic Courtès wrote:
> I think we now have an overview of the possibilities (including maybe
> ‘itstool’ that Ricardo mentions.)  I’d say that whoever is interested
> should give it a try with what looks like the most promising approach
> and report back with a prototype.  :-)
> 

I tried to make gettext usable (not yet implementing any discussed
approach), but it is a little rough: I tried using msgctxts.  Sadly
Guile is missing a pgettext function, I think.  Should I use Guile’s
ffi?  I think msgctxts could help with fragmentation, as I would
prefer format strings with msgctxt over HTML-that-is-not-SHTML with
itstool (I may misunderstand itstool though).

sirgazil (Cc), long ago at
<https://lists.gnu.org/archive/html/guile-user/2017-12/msg00071.html>
you said you had written an interleave function for format strings.
Do you have the code somewhere?  I see in the commit log you are still
actively working on the Guix website.

Also, I believe this discussion is actually
<https://issues.guix.info/issue/26302>.  Should I reference this
thread there?

Regards,
Florian

[-- Attachment #2: 0001-website-Use-needed-modules-in-posts.patch --]
[-- Type: text/plain, Size: 1529 bytes --]

From f0bb0180dca729aa2c13f881780b279a08f9ea53 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Thu, 18 Jul 2019 10:22:44 +0200
Subject: [PATCH 1/2] website: Use needed modules in posts.

* website/posts/back-from-seagl-2018.sxml: Use needed modules.
* website/posts/guix-at-libreplanet-2016.sxml: Use needed modules.
---
 website/posts/back-from-seagl-2018.sxml     | 3 ++-
 website/posts/guix-at-libreplanet-2016.sxml | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/website/posts/back-from-seagl-2018.sxml b/website/posts/back-from-seagl-2018.sxml
index c5ad0a9..958369f 100644
--- a/website/posts/back-from-seagl-2018.sxml
+++ b/website/posts/back-from-seagl-2018.sxml
@@ -1,6 +1,7 @@
 (begin
   (use-modules (apps base templates components)
-	           (srfi srfi-19))
+               (apps base utils)
+               (srfi srfi-19))
   `((title . "Back from SeaGL 2018")
     (author . "Chris Marusich")
     (date . ,(make-date 0 0 0 0 10 12 2018 -28800))
diff --git a/website/posts/guix-at-libreplanet-2016.sxml b/website/posts/guix-at-libreplanet-2016.sxml
index 8581be4..252def3 100644
--- a/website/posts/guix-at-libreplanet-2016.sxml
+++ b/website/posts/guix-at-libreplanet-2016.sxml
@@ -1,5 +1,6 @@
 (begin
-  (use-modules (srfi srfi-19))
+  (use-modules (srfi srfi-19)
+               (apps base templates components))
   `((title . "Guix at LibrePlanet 2016")
     (author . "David Thompson")
     (date unquote (make-date 0 0 0 0 15 3 2016 3600))
-- 
2.22.0


[-- Attachment #3: 0002-wip-website-Add-some-gettext-support.patch --]
[-- Type: text/plain, Size: 10797 bytes --]

From 5b84fb9d20668eb777832f88ad9bc0c8549e92d2 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Thu, 18 Jul 2019 16:39:00 +0200
Subject: [PATCH 2/2] [wip] website: Add some gettext support.

* website/apps/base/templates/home.scm (home-t): Mark two messages
with G_ for testing.
* website/po/POTFILES: New file; list the above file here.
* website/po/guix-website.pot: New file; generated from the above.
* website/po/de.po: New file.
* website/po/LINGUAS: New file.  Add linguas for testing.  Currently
their country code has to be specified too.
* website/apps/i18n.scm: New file.  Add utility functions.
* website/haunt.scm: Load linguas and call each builder with each.
* website/wip-howto-test-translation: New file with unfinished
instructions.
---
 website/apps/base/templates/home.scm |  7 ++-
 website/apps/i18n.scm                | 89 ++++++++++++++++++++++++++++
 website/haunt.scm                    | 24 ++++++--
 website/po/LINGUAS                   |  2 +
 website/po/POTFILES                  |  1 +
 website/po/de.po                     | 30 ++++++++++
 website/po/guix-website.pot          | 30 ++++++++++
 website/wip-howto-test-translation   | 27 +++++++++
 8 files changed, 201 insertions(+), 9 deletions(-)
 create mode 100644 website/apps/i18n.scm
 create mode 100644 website/po/LINGUAS
 create mode 100644 website/po/POTFILES
 create mode 100644 website/po/de.po
 create mode 100644 website/po/guix-website.pot
 create mode 100644 website/wip-howto-test-translation

diff --git a/website/apps/base/templates/home.scm b/website/apps/base/templates/home.scm
index 5cb3bf5..0eb25a3 100644
--- a/website/apps/base/templates/home.scm
+++ b/website/apps/base/templates/home.scm
@@ -8,6 +8,7 @@
   #:use-module (apps base types)
   #:use-module (apps base utils)
   #:use-module (apps blog templates components)
+  #:use-module (apps i18n)
   #:export (home-t))
 
 
@@ -37,9 +38,9 @@
       (h2 (@ (class "a11y-offset")) "Summary")
       (ul
        (li
-	(b "Liberating.")
-	" Guix is an advanced
-        distribution of the "
+	(b (G_ "Liberating." "featured content"))
+	(G_ " Guix is an advanced
+        distribution of the " "featured content")
 	,(link-yellow
 	  #:label "GNU operating system"
 	  #:url (gnu-url "gnu/about-gnu.html"))
diff --git a/website/apps/i18n.scm b/website/apps/i18n.scm
new file mode 100644
index 0000000..54a975f
--- /dev/null
+++ b/website/apps/i18n.scm
@@ -0,0 +1,89 @@
+;;; GNU Guix web site
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
+;;;
+;;; This file is part of the GNU Guix web site.
+;;;
+;;; The GNU Guix web site is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; The GNU Guix web site 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 Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with the GNU Guix web site.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (apps i18n)
+  #:use-module (haunt page)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (G_
+            %current-lingua
+            builder->localized-builder
+            builders->localized-builders))
+
+(define %gettext-domain
+  "guix-website")
+
+(bindtextdomain %gettext-domain (getcwd))
+(bind-textdomain-codeset %gettext-domain "UTF-8")
+(textdomain %gettext-domain)
+
+(define* (G_ msg msgctxt)
+  (if msgctxt
+      (gettext (string-append msgctxt "|" msg) %gettext-domain)
+      (gettext msg %gettext-domain)))
+
+(define <page>
+  (@@ (haunt page) <page>))
+
+(define %current-lingua
+  (make-fluid "en_US"))
+
+(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 I THINK"
+  arg)
+
+(define (builder->localized-builder builder lingua)
+  (compose
+   (lambda (pages)
+     (map
+      (lambda (page)
+        (match page
+          (($ <page> file-name contents writer)
+           (if (string-suffix? ".html" file-name)
+               (let* ((base (string-drop-right
+                             file-name
+                             (string-length ".html")))
+                      (new-name (string-append base
+                                               "."
+                                               lingua
+                                               ".html")))
+                 (make-page new-name contents writer))
+               page))
+          (else page)))
+      pages))
+   (lambda (site posts)
+     (begin
+       (setlocale LC_ALL (string-append lingua ".utf8"))
+       (with-fluid*
+           %current-lingua lingua
+           (lambda _
+             (begin
+               (first-value (builder site posts)))))))))
+
+(define (builders->localized-builders builders linguas)
+  (flatten
+   (map-in-order
+    (lambda (builder)
+      (map-in-order
+       (lambda (lingua)
+         (builder->localized-builder builder lingua))
+       linguas))
+    builders)))
diff --git a/website/haunt.scm b/website/haunt.scm
index d29c0d4..eb0eafe 100644
--- a/website/haunt.scm
+++ b/website/haunt.scm
@@ -5,13 +5,23 @@
 (use-modules ((apps base builder) #:prefix base:)
 	     ((apps blog builder) #:prefix blog:)
 	     ((apps download builder) #:prefix download:)
+             (apps i18n)
 	     ((apps packages builder) #:prefix packages:)
 	     (haunt asset)
              (haunt builder assets)
              (haunt reader)
 	     (haunt reader commonmark)
-             (haunt site))
+             (haunt site)
+             (ice-9 rdelim)
+             (srfi srfi-1))
 
+(define linguas
+  (with-input-from-file "po/LINGUAS"
+    (lambda _
+      (let loop ((line (read-line)))
+        (if (eof-object? line)
+            '()
+            (cons line (loop (read-line))))))))
 
 (site #:title "GNU Guix"
       #:domain (if (getenv "GUIX_WEB_SITE_INFO")
@@ -19,8 +29,10 @@
                    "https://gnu.org/software/guix")
       #:build-directory "/tmp/gnu.org/software/guix"
       #:readers (list sxml-reader html-reader commonmark-reader)
-      #:builders (list base:builder
-		       blog:builder
-		       download:builder
-		       packages:builder
-		       (static-directory "static")))
+      #:builders (builders->localized-builders
+                  (list base:builder
+                        blog:builder
+                        download:builder
+                        packages:builder
+                        (static-directory "static"))
+                  linguas))
diff --git a/website/po/LINGUAS b/website/po/LINGUAS
new file mode 100644
index 0000000..782116d
--- /dev/null
+++ b/website/po/LINGUAS
@@ -0,0 +1,2 @@
+de_DE
+en_US
diff --git a/website/po/POTFILES b/website/po/POTFILES
new file mode 100644
index 0000000..0007797
--- /dev/null
+++ b/website/po/POTFILES
@@ -0,0 +1 @@
+apps/base/templates/home.scm
diff --git a/website/po/de.po b/website/po/de.po
new file mode 100644
index 0000000..3add92e
--- /dev/null
+++ b/website/po/de.po
@@ -0,0 +1,30 @@
+# German translations for guix-website package.
+# Copyright (C) 2019 Ludovic Courtès
+# This file is distributed under the same license as the guix-website package.
+# Automatically generated, 2019.
+#
+msgid ""
+msgstr ""
+"Project-Id-Version: guix-website\n"
+"Report-Msgid-Bugs-To: ludo@gnu.org\n"
+"POT-Creation-Date: 2019-07-18 16:31+0200\n"
+"PO-Revision-Date: 2019-07-18 16:33+0200\n"
+"Last-Translator: Automatically generated\n"
+"Language-Team: none\n"
+"Language: de\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"Plural-Forms: nplurals=2; plural=(n != 1);\n"
+
+#: apps/base/templates/home.scm:41
+msgctxt "featured content"
+msgid "Liberating."
+msgstr "Befreiend."
+
+#: apps/base/templates/home.scm:42
+msgctxt "featured content"
+msgid ""
+" Guix is an advanced\n"
+"        distribution of the "
+msgstr "Guix ist eine fortgeschrittene Distribution des "
diff --git a/website/po/guix-website.pot b/website/po/guix-website.pot
new file mode 100644
index 0000000..709077a
--- /dev/null
+++ b/website/po/guix-website.pot
@@ -0,0 +1,30 @@
+# SOME DESCRIPTIVE TITLE.
+# Copyright (C) YEAR Ludovic Courtès
+# This file is distributed under the same license as the guix-website package.
+# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
+#
+#, fuzzy
+msgid ""
+msgstr ""
+"Project-Id-Version: guix-website\n"
+"Report-Msgid-Bugs-To: ludo@gnu.org\n"
+"POT-Creation-Date: 2019-07-18 16:31+0200\n"
+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
+"Language-Team: LANGUAGE <LL@li.org>\n"
+"Language: \n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+
+#: apps/base/templates/home.scm:41
+msgctxt "featured content"
+msgid "Liberating."
+msgstr ""
+
+#: apps/base/templates/home.scm:42
+msgctxt "featured content"
+msgid ""
+" Guix is an advanced\n"
+"        distribution of the "
+msgstr ""
diff --git a/website/wip-howto-test-translation b/website/wip-howto-test-translation
new file mode 100644
index 0000000..f2f319b
--- /dev/null
+++ b/website/wip-howto-test-translation
@@ -0,0 +1,27 @@
+To create a pot file:
+
+xgettext -f po/POTFILES -o po/guix-website.pot --from-code=UTF-8 --copyright-holder="Ludovic Courtès" --package-name="guix-website" --msgid-bugs-address="ludo@gnu.org" --keyword=G_:1,2c
+
+To create a po file from a pot file, do the usual:
+
+cd po
+msginit -l de --no-translator
+
+To merge an existing po file with a new pot file:
+
+cd po
+msgmerge -U de.po guix-website.pot
+
+To update mo files:
+
+mkdir -p de/LC_MESSAGES
+cd po
+msgfmt de.po
+cd ..
+mv po/messages.mo de/LC_MESSAGES/guix-website.mo
+
+To test:
+
+guix environment --ad-hoc haunt
+GUILE_LOAD_PATH=$(guix build guile-syntax-highlight)/share/guile/site/2.2:$GUILE_LOAD_PATH GUIX_WEB_SITE_LOCAL=yes haunt build
+GUILE_LOAD_PATH=$(guix build guile-syntax-highlight)/share/guile/site/2.2:$GUILE_LOAD_PATH haunt serve
-- 
2.22.0

Re: Website translation

[Ricardo Wurmus]

pelzflorian (Florian Pelz) <pelzflorian@pelzflorian.de> writes:

> I think msgctxts could help with fragmentation, as I would
> prefer format strings with msgctxt over HTML-that-is-not-SHTML with
> itstool (I may misunderstand itstool though).

I don’t understand.  itstool operates on plain old XML fragments.

What’s the desired workflow?

-- 
Ricardo

Re: Website translation

[pelzflorian (Florian Pelz)]

On Thu, Jul 18, 2019 at 06:59:32PM +0200, Ricardo Wurmus wrote:
> 
> pelzflorian (Florian Pelz) <pelzflorian@pelzflorian.de> writes:
> 
> > I think msgctxts could help with fragmentation, as I would
> > prefer format strings with msgctxt over HTML-that-is-not-SHTML with
> > itstool (I may misunderstand itstool though).
> 
> I don’t understand.  itstool operates on plain old XML fragments.
> 

At first I thought of plain HTML strings, but it surely was a
misunderstanding.

I now get the impression itstool is something like Glade’s
<https://pelzflorian.de/git/gui-prog-gtk/tree/bin/copyshop/src/ui/menu.ui>.
I suppose it is a wrong impression again?


> What’s the desired workflow?

Something like

(li
 (b "Liberating.")
 " Guix is an advanced
distribution of the "
 ,(link-yellow
   #:label "GNU operating system"
   #:url (gnu-url "gnu/about-gnu.html"))
 " developed by the "
 ,(link-yellow
   #:label "GNU Project"
   #:url (gnu-url))
 "—which respects the "
 ,(link-yellow
   #:label "freedom of computer users"
   #:url (gnu-url "distros/free-system-distribution-guidelines.html"))
 ". ")

could be something like

(li
 (b ,(G_ "Liberating."))
 ,(I_ " Guix is an advanced distribution of the
<gnu-url-link path='gnu/about-gnu.html'>GNU operating system</link>
 developed by the <gnu-url-link>GNU Project
</gnu-url-link>—which respects the <gnu-url-link
 path='distros/free-system-distribution-guidelines.html'>
freedom of computer users</gnu-url-link>. "
      `(gnu-url-link
        . ,(lambda* (content #:key (path ""))
             (link-yellow
              #:label content
              #:url (gnu-url path))))))

or could be format strings like sirgazil’s code

(li
 (b ,(G_ "Liberating."))
 ,(I_ " Guix is an advanced
distribution of the ~GNU OS~ developed
by the ~PROJECT~—which respects the
~FREEDOM~. "
      (link-yellow
       #:label (G_ "GNU operating system")
       #:url (gnu-url "gnu/about-gnu.html"))
      (link-yellow
       #:label (G_ "GNU Project")
       #:url (gnu-url))
      (link-yellow
       #:label (G_ "freedom of computer users")
       #:url (gnu-url "distros/free-system-distribution-guidelines.html"))))

with the po file containing

#: apps/base/templates/home.scm:42
msgid ""
" Guix is an advanced\n"
"distribution of the ~GNU OS~ developed\n"
"by the ~PROJECT~—which respects the\n"
"~FREEDOM~. "
msgstr ""
"Guix ist eine vom ~PROJECT~ entwickelte,"
"fortgeschrittene Distribution des ~GNU OS~"
" — die die ~FREEDOM~ respektiert."

#: apps/base/templates/home.scm:47
msgid "GNU operating system"
msgstr "GNU-Betriebssystems"

#: apps/base/templates/home.scm:50
msgid "GNU Project"
msgstr "GNU-Projekt"

#: apps/base/templates/home.scm:50
msgid "freedom of computer users"
msgstr "Freiheit, wie man seinen Rechner benutzt,"


Format strings yield fragmented PO files, which is why it might be
better to use them with a msgctxt/pgettext.  For example, "GNU
operating system" may need different translations and grammatical
cases in different places on the website.  Without pgettext, this
approach does not work, it seems.


Another option I would like the most is using a custom PO file writer
and MO file reader that generates a single msgid directly from the
original nested s-expression.  Such a procedure seems nice to use, but
complicated to implement.

Regards,
Florian

Re: Website translation

[pelzflorian (Florian Pelz)]

On Thu, Jul 18, 2019 at 10:28:31PM +0200, pelzflorian (Florian Pelz) wrote:
> On Thu, Jul 18, 2019 at 06:59:32PM +0200, Ricardo Wurmus wrote:
> > I don’t understand.  itstool operates on plain old XML fragments.
> > 
> 
> At first I thought of plain HTML strings, but it surely was a
> misunderstanding.
> 
> I now get the impression itstool is something like Glade’s
> <https://pelzflorian.de/git/gui-prog-gtk/tree/bin/copyshop/src/ui/menu.ui>.
> I suppose it is a wrong impression again?
> 
> 

Sorry, I see now
<https://lists.gnu.org/archive/html/guile-user/2017-12/msg00065.html>.
I should have looked more closely.

Re: Website translation

[pelzflorian (Florian Pelz)]

On Thu, Jul 18, 2019 at 10:28:31PM +0200, pelzflorian (Florian Pelz) wrote:
> Another option I would like the most is using a custom PO file writer
> and MO file reader that generates a single msgid directly from the
> original nested s-expression.  Such a procedure seems nice to use, but
> complicated to implement.
> 

I will try writing a custom xgettext that combines
nested·s-expressions·that are marked for translation with G_
to·a·single·msgstr that gets written to the·PO·file.  This combined
string will not be part of the source code but will be generated from
a nested sexp.  The PO file containing the combined strings can then
be translated as usual.  For reading the translation, the combined
msgstr will be constructed again by the marking procedure G_ and
looked up by reading from an MO file.

It will take me a few days and a MO file reader will still be missing.
I suppose it would be easier to use for the sxml’s author who would
not need to write special code to internationalize the sxml.

Regards,
Florian

Re: Website translation

[pelzflorian (Florian Pelz)]

[-- Attachment #1: Type: text/plain, Size: 1432 bytes --]

On Fri, Jul 19, 2019 at 02:29:52PM +0200, pelzflorian (Florian Pelz) wrote:
> I will try writing a custom xgettext that combines
> nested·s-expressions·that are marked for translation with G_
> to·a·single·msgstr that gets written to the·PO·file.  This combined
> string will not be part of the source code but will be generated from
> a nested sexp.  The PO file containing the combined strings can then
> be translated as usual.  For reading the translation, the combined
> msgstr will be constructed again by the marking procedure G_ and
> looked up by reading from an MO file.
> 
> It will take me a few days and a MO file reader will still be missing.
> I suppose it would be easier to use for the sxml’s author who would
> not need to write special code to internationalize the sxml.
> 

Find attached a work-in-progress patch to guix-artwork that constructs
PO entries from nested sexps.  Also attached is a file marked for
translation and the POT file generated from it.  No custom MO reader
is needed because gettext is a fine MO reader, the problem is only
xgettext that cannot extract sexps.  Currently missing though is a
procedure or macro for deconstructing the msgstr to an sexp, so the
patch can only generate unusable POT files at the moment.  I will take
a look at it now, but it may again take a week.  Please tell me if you
think this is the wrong approach.

Regards,
Florian

[-- Attachment #2: 0001-wip-website-Use-custom-xgettext-implementation-that-.patch --]
[-- Type: text/plain, Size: 50868 bytes --]

From 1f126de9d16f1eb78d1d8846ddfad7d3e84bb1d4 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Fri, 26 Jul 2019 12:58:18 +0200
Subject: [PATCH] [wip] website: Use custom xgettext implementation that can
 extract from nested sexps.

* website/scripts/sexp-xgettext.scm: New file for generating a PO file.
* website/sexp-xgettext.scm: New file with module for looking up
translations.
* website/apps/base/templates/home.scm (home-t): Mark for translation
for testing.
* website/po/POTFILES: New file; list the above file here.
* website/po/guix-website.pot: New file; generated from the above.
* website/po/de.po: New file.
* website/po/LINGUAS: New file.  Add linguas for testing.  Currently
their country code has to be specified too.
* website/apps/i18n.scm: New file.  Add utility functions.
* website/haunt.scm: Load linguas and call each builder with each.
* website/wip-howto-test-translation: New file with unfinished
instructions.
---
 website/apps/base/templates/home.scm | 231 +++++------
 website/apps/i18n.scm                |  96 +++++
 website/haunt.scm                    |  24 +-
 website/po/LINGUAS                   |   2 +
 website/po/POTFILES                  |   1 +
 website/po/de.po                     |  30 ++
 website/po/guix-website.pot          |  78 ++++
 website/scripts/sexp-xgettext.scm    | 575 +++++++++++++++++++++++++++
 website/sexp-xgettext.scm            |  31 ++
 website/wip-howto-test-translation   |  27 ++
 10 files changed, 978 insertions(+), 117 deletions(-)
 create mode 100644 website/apps/i18n.scm
 create mode 100644 website/po/LINGUAS
 create mode 100644 website/po/POTFILES
 create mode 100644 website/po/de.po
 create mode 100644 website/po/guix-website.pot
 create mode 100644 website/scripts/sexp-xgettext.scm
 create mode 100644 website/sexp-xgettext.scm
 create mode 100644 website/wip-howto-test-translation

diff --git a/website/apps/base/templates/home.scm b/website/apps/base/templates/home.scm
index 5cb3bf5..09e24ba 100644
--- a/website/apps/base/templates/home.scm
+++ b/website/apps/base/templates/home.scm
@@ -14,17 +14,18 @@
 (define (home-t context)
   "Return the Home page in SHTML using the data in CONTEXT."
   (theme
-   #:title '("GNU's advanced distro and transactional package manager")
+   #:title (list (G_ "GNU's advanced distro and transactional package manager"))
    #:description
-   "Guix is an advanced distribution of the GNU operating system.
+   (G_ "Guix is an advanced distribution of the GNU operating system.
    Guix is technology that respects the freedom of computer users.
    You are free to run the system for any purpose, study how it works,
-   improve it, and share it with the whole world."
+   improve it, and share it with the whole world.")
    #:keywords
-   '("GNU" "Linux" "Unix" "Free software" "Libre software"
-     "Operating system" "GNU Hurd" "GNU Guix package manager"
-     "GNU Guile" "Guile Scheme" "Transactional upgrades"
-     "Functional package management" "Reproducibility")
+   (string-split ;TRANSLATORS: |-separated list of webpage keywords
+    (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
+system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile \
+Scheme|Transactional upgrades|Functional package \
+management|Reproducibility"))
    #:active-menu-item "Overview"
    #:css (list
 	  (guix-url "static/base/css/item-preview.css")
@@ -34,83 +35,88 @@
      ;; Featured content.
      (section
       (@ (class "featured-content"))
-      (h2 (@ (class "a11y-offset")) "Summary")
+      (G_ `(h2 (@ (class "a11y-offset")) "Summary"))
       (ul
-       (li
-	(b "Liberating.")
-	" Guix is an advanced
-        distribution of the "
-	,(link-yellow
-	  #:label "GNU operating system"
-	  #:url (gnu-url "gnu/about-gnu.html"))
-	" developed by the "
-	,(link-yellow
-	  #:label "GNU Project"
-	  #:url (gnu-url))
-	"—which respects the "
-	,(link-yellow
-	  #:label "freedom of computer users"
-	  #:url (gnu-url "distros/free-system-distribution-guidelines.html"))
-	". ")
-
-       (li
-	(b "Dependable.")
-        " Guix "
-	,(link-yellow
-	  #:label "supports"
-	  #:url (manual-url "Package-Management.html"))
-        " transactional upgrades and roll-backs, unprivileged
-        package management, "
-	,(link-yellow
-	  #:label "and more"
-	  #:url (manual-url "Features.html"))
-	".  When used as a standalone distribution, Guix supports "
-        ,(link-yellow
-          #:label "declarative system configuration"
-          #:url (manual-url "Using-the-Configuration-System.html"))
-        " for transparent and reproducible operating systems.")
-
-       (li
-	(b "Hackable.")
-	" It provides "
-	,(link-yellow
-	  #:label "Guile Scheme"
-	  #:url (gnu-url "software/guile/"))
-	" APIs, including high-level embedded domain-specific
-        languages (EDSLs) to "
-	,(link-yellow
-	  #:label "define packages"
-	  #:url (manual-url "Defining-Packages.html"))
-	" and "
-	,(link-yellow
-	  #:label "whole-system configurations"
-	  #:url (manual-url "System-Configuration.html"))
-	"."))
+       ,(G_
+         `(li
+           ,(G_ `(b "Liberating."))
+           " Guix is an advanced distribution of the "
+           ,(G_ (link-yellow
+                 #:label "GNU operating system"
+                 #:url (gnu-url "gnu/about-gnu.html")))
+           " developed by the "
+           ,(G_ (link-yellow
+                 #:label "GNU Project"
+                 #:url (gnu-url)))
+           "—which respects the "
+           ,(G_ (link-yellow
+                 #:label "freedom of computer users"
+                 #:url (gnu-url "distros/free-system-distribution-\
+guidelines.html")))
+           ". "))
+
+       (G_
+        `(li
+          ,(G_ `(b "Dependable."))
+          " Guix "
+          ,(G_ (link-yellow
+                #:label "supports"
+                #:url (manual-url "Package-Management.html")))
+          " transactional upgrades and roll-backs, unprivileged \
+package management, "
+          ,(G_ (link-yellow
+                #:label "and more"
+                #:url (manual-url "Features.html")))
+          ".  When used as a standalone distribution, Guix supports "
+          ,(G_ (link-yellow
+                #:label "declarative system configuration"
+                #:url (manual-url "Using-the-Configuration-System.html")))
+          " for transparent and reproducible operating systems."))
+
+       (G_
+        `(li
+          ,(G_ `(b "Hackable."))
+          " It provides "
+          ,(G_ (link-yellow
+                #:label "Guile Scheme"
+                #:url (gnu-url "software/guile/")))
+          " APIs, including high-level embedded domain-specific \
+languages (EDSLs) to "
+         ,(G_ (link-yellow
+               #:label "define packages"
+               #:url (manual-url "Defining-Packages.html")))
+         " and "
+         ,(G_ (link-yellow
+               #:label "whole-system configurations"
+               #:url (manual-url "System-Configuration.html")))
+         ".")))
 
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label (string-append "DOWNLOAD v" (latest-guix-version))
+         #:label (C_ (string-append "DOWNLOAD v" (latest-guix-version))
+                     "button")
 	 #:url (guix-url "download/")
 	 #:light #true)
        " " ; A space for readability in non-CSS browsers.
        ,(button-big
-	 #:label "CONTRIBUTE"
+         #:label (C_ "CONTRIBUTE" "button")
 	 #:url (guix-url "contribute/")
 	 #:light #true)))
 
      ;; Discover Guix.
      (section
       (@ (class "discovery-box"))
-      (h2 "Discover Guix")
+      (G_ `(h2 "Discover Guix"))
 
-      (p
-       (@ (class "limit-width centered-block"))
-       "Guix comes with thousands of packages which include
-       applications, system tools, documentation, fonts, and other
-       digital goods readily available for installing with the "
-       ,(link-yellow #:label "GNU Guix" #:url "#guix-in-other-distros")
-       " package manager.")
+      (G_
+       `(p
+         (@ (class "limit-width centered-block"))
+         "Guix comes with thousands of packages which include \
+applications, system tools, documentation, fonts, and other digital \
+goods readily available for installing with the "
+         ,(G_ `(link-yellow #:label "GNU Guix" #:url "#guix-in-other-distros"))
+         " package manager."))
 
       (div
        (@ (class "screenshots-box"))
@@ -119,55 +125,57 @@
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label "ALL PACKAGES"
+         #:label (C_ "ALL PACKAGES" "button")
 	 #:url (guix-url "packages/")
 	 #:light #true))
 
       ,(horizontal-separator #:light #true)
 
       ;; Guix in different fields.
-      (h3 "GNU Guix in your field")
+      (G_ `(h3 "GNU Guix in your field"))
 
-      (p
-       (@ (class "limit-width centered-block"))
-       "Read some stories about how people are using GNU Guix in their daily
-       lives.")
+      (G_
+       `(p
+         (@ (class "limit-width centered-block"))
+         "Read some stories about how people are using GNU Guix in
+their daily lives."))
 
       (div
        (@ (class "fields-box"))
 
        " " ; A space for readability in non-CSS browsers (same below).
        ,(button-big
-	 #:label "SOFTWARE DEVELOPMENT"
-	 #:url (guix-url "blog/tags/software-development/")
-	 #:light #true)
+         #:label (C_ "SOFTWARE DEVELOPMENT" "button")
+         #:url (guix-url "blog/tags/software-development/")
+         #:light #true)
        " "
        ,(button-big
-	 #:label "BIOINFORMATICS"
-	 #:url (guix-url "blog/tags/bioinformatics/")
-	 #:light #true)
+         #:label (C_ "BIOINFORMATICS" "button")
+         #:url (guix-url "blog/tags/bioinformatics/")
+         #:light #true)
        " "
        ,(button-big
-	 #:label "HIGH PERFORMANCE COMPUTING"
-	 #:url (guix-url "blog/tags/high-performance-computing/")
-	 #:light #true)
+         #:label (C_ "HIGH PERFORMANCE COMPUTING" "button")
+         #:url (guix-url "blog/tags/high-performance-computing/")
+         #:light #true)
        " "
        ,(button-big
-	 #:label "RESEARCH"
-	 #:url (guix-url "blog/tags/research/")
-	 #:light #true)
+         #:label (C_ "RESEARCH" "button")
+         #:url (guix-url "blog/tags/research/")
+         #:light #true)
        " "
        ,(button-big
-	 #:label "ALL FIELDS..."
-	 #:url (guix-url "blog/")
-	 #:light #true))
+         #:label (C_ "ALL FIELDS..." "button")
+         #:url (guix-url "blog/")
+         #:light #true))
 
       ,(horizontal-separator #:light #true)
 
       ;; Using Guix in other distros.
-      (h3
-       (@ (id "guix-in-other-distros"))
-       "GNU Guix in other GNU/Linux distros")
+      (G_
+       `(h3
+         (@ (id "guix-in-other-distros"))
+         "GNU Guix in other GNU/Linux distros"))
 
       (div
        (@ (class "info-box"))
@@ -176,54 +184,55 @@
 	   (src "https://audio-video.gnu.org/video/misc/2016-07__GNU_Guix_Demo_2.webm")
 	   (poster ,(guix-url "static/media/img/guix-demo.png"))
 	   (controls "controls"))
-	(p
-	 "Video: "
-	 ,(link-yellow
-	   #:label "Demo of Guix in another GNU/Linux distribution"
-	   #:url "https://audio-video.gnu.org/video/misc/2016-07__GNU_Guix_Demo_2.webm")
-	 " (1 minute, 30 seconds).")))
+        (G_
+         `(p
+           "Video: "
+           ,(G_ (link-yellow
+                 #:label "Demo of Guix in another GNU/Linux distribution"
+                 #:url "https://audio-video.gnu.org/video/misc/\
+2016-07__GNU_Guix_Demo_2.webm"))
+           " (1 minute, 30 seconds)."))))
 
       (div
        (@ (class "info-box justify-left"))
-       (p
-	"If you don't use GNU Guix as a standalone GNU/Linux distribution,
-        you still can use it as a
-	package manager on top of any GNU/Linux distribution. This
-        way, you can benefit from all its conveniences.")
+       ,(G_ `(p
+              "If you don't use GNU Guix as a standalone GNU/Linux \
+distribution, you still can use it as a package manager on top of any \
+GNU/Linux distribution. This way, you can benefit from all its conveniences."))
 
-       (p
-	"Guix won't interfere with the package manager that comes
-        with your distribution. They can live together."))
+       ,(G_ `(p
+              "Guix won't interfere with the package manager that comes \
+with your distribution. They can live together.")))
 
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label "TRY IT OUT!"
+         #:label (C_ "TRY IT OUT!" "button")
 	 #:url (guix-url "download/")
 	 #:light #true)))
 
      ;; Latest Blog posts.
      (section
       (@ (class "centered-text"))
-      (h2 "Blog")
+      (G_ `(h2 "Blog"))
 
       ,@(map post-preview (context-datum context "posts"))
 
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label "ALL POSTS"
+         #:label (C_ "ALL POSTS" "button")
 	 #:url (guix-url "blog/"))))
 
      ;; Contact info.
      (section
       (@ (class "contact-box centered-text"))
-      (h2 "Contact")
+      (G_ (h2 "Contact"))
 
       ,@(map contact-preview (context-datum context "contact-media"))
 
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label "ALL CONTACT MEDIA"
+         #:label (C_ "ALL CONTACT MEDIA" "button")
 	 #:url (guix-url "contact/")))))))
diff --git a/website/apps/i18n.scm b/website/apps/i18n.scm
new file mode 100644
index 0000000..53fb963
--- /dev/null
+++ b/website/apps/i18n.scm
@@ -0,0 +1,96 @@
+;;; GNU Guix web site
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
+;;;
+;;; This file is part of the GNU Guix web site.
+;;;
+;;; The GNU Guix web site is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; The GNU Guix web site 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 Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with the GNU Guix web site.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (apps i18n)
+  #:use-module (haunt page)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 match)
+  #:use-module (sexp-xgettext)
+  #:use-module (srfi srfi-1)
+  #:export (G_
+            N_
+            C_
+            %current-lingua
+            builder->localized-builder
+            builders->localized-builders))
+
+(define %gettext-domain
+  "guix-website")
+
+(bindtextdomain %gettext-domain (getcwd))
+(bind-textdomain-codeset %gettext-domain "UTF-8")
+(textdomain %gettext-domain)
+
+;; TODO deconstruct an sexp instead of directly receiving a msg
+(define* (G_ msg) ;like gettext
+  (gettext msg %gettext-domain))
+
+(define* (N_ msg msgplural n) ;like ngettext
+  (ngettext msg msgplural %gettext-domain))
+
+(define* (C_ msg msgctxt) ;like pgettext
+  msg);TODO
+
+(define <page>
+  (@@ (haunt page) <page>))
+
+(define %current-lingua
+  (make-parameter "en_US"))
+
+(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 I THINK"
+  arg)
+
+(define (builder->localized-builder builder lingua)
+  (compose
+   (lambda (pages)
+     (map
+      (lambda (page)
+        (match page
+          (($ <page> file-name contents writer)
+           (if (string-suffix? ".html" file-name)
+               (let* ((base (string-drop-right
+                             file-name
+                             (string-length ".html")))
+                      (new-name (string-append base
+                                               "."
+                                               lingua
+                                               ".html")))
+                 (make-page new-name contents writer))
+               page))
+          (else page)))
+      pages))
+   (lambda (site posts)
+     (begin
+       (setlocale LC_ALL (string-append lingua ".utf8"))
+       (parameterize ((%current-lingua lingua))
+         (lambda _
+           (begin
+             (first-value (builder site posts)))))))))
+
+(define (builders->localized-builders builders linguas)
+  (flatten
+   (map-in-order
+    (lambda (builder)
+      (map-in-order
+       (lambda (lingua)
+         (builder->localized-builder builder lingua))
+       linguas))
+    builders)))
diff --git a/website/haunt.scm b/website/haunt.scm
index d29c0d4..eb0eafe 100644
--- a/website/haunt.scm
+++ b/website/haunt.scm
@@ -5,13 +5,23 @@
 (use-modules ((apps base builder) #:prefix base:)
 	     ((apps blog builder) #:prefix blog:)
 	     ((apps download builder) #:prefix download:)
+             (apps i18n)
 	     ((apps packages builder) #:prefix packages:)
 	     (haunt asset)
              (haunt builder assets)
              (haunt reader)
 	     (haunt reader commonmark)
-             (haunt site))
+             (haunt site)
+             (ice-9 rdelim)
+             (srfi srfi-1))
 
+(define linguas
+  (with-input-from-file "po/LINGUAS"
+    (lambda _
+      (let loop ((line (read-line)))
+        (if (eof-object? line)
+            '()
+            (cons line (loop (read-line))))))))
 
 (site #:title "GNU Guix"
       #:domain (if (getenv "GUIX_WEB_SITE_INFO")
@@ -19,8 +29,10 @@
                    "https://gnu.org/software/guix")
       #:build-directory "/tmp/gnu.org/software/guix"
       #:readers (list sxml-reader html-reader commonmark-reader)
-      #:builders (list base:builder
-		       blog:builder
-		       download:builder
-		       packages:builder
-		       (static-directory "static")))
+      #:builders (builders->localized-builders
+                  (list base:builder
+                        blog:builder
+                        download:builder
+                        packages:builder
+                        (static-directory "static"))
+                  linguas))
diff --git a/website/po/LINGUAS b/website/po/LINGUAS
new file mode 100644
index 0000000..782116d
--- /dev/null
+++ b/website/po/LINGUAS
@@ -0,0 +1,2 @@
+de_DE
+en_US
diff --git a/website/po/POTFILES b/website/po/POTFILES
new file mode 100644
index 0000000..0007797
--- /dev/null
+++ b/website/po/POTFILES
@@ -0,0 +1 @@
+apps/base/templates/home.scm
diff --git a/website/po/de.po b/website/po/de.po
new file mode 100644
index 0000000..3add92e
--- /dev/null
+++ b/website/po/de.po
@@ -0,0 +1,30 @@
+# German translations for guix-website package.
+# Copyright (C) 2019 Ludovic Courtès
+# This file is distributed under the same license as the guix-website package.
+# Automatically generated, 2019.
+#
+msgid ""
+msgstr ""
+"Project-Id-Version: guix-website\n"
+"Report-Msgid-Bugs-To: ludo@gnu.org\n"
+"POT-Creation-Date: 2019-07-18 16:31+0200\n"
+"PO-Revision-Date: 2019-07-18 16:33+0200\n"
+"Last-Translator: Automatically generated\n"
+"Language-Team: none\n"
+"Language: de\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"Plural-Forms: nplurals=2; plural=(n != 1);\n"
+
+#: apps/base/templates/home.scm:41
+msgctxt "featured content"
+msgid "Liberating."
+msgstr "Befreiend."
+
+#: apps/base/templates/home.scm:42
+msgctxt "featured content"
+msgid ""
+" Guix is an advanced\n"
+"        distribution of the "
+msgstr "Guix ist eine fortgeschrittene Distribution des "
diff --git a/website/po/guix-website.pot b/website/po/guix-website.pot
new file mode 100644
index 0000000..0c180fe
--- /dev/null
+++ b/website/po/guix-website.pot
@@ -0,0 +1,78 @@
+
+msgid "GNU's advanced distro and transactional package manager"
+msgstr ""
+
+msgid "Guix is an advanced distribution of the GNU operating system.\n   Guix is technology that respects the freedom of computer users.\n   You are free to run the system for any purpose, study how it works,\n   improve it, and share it with the whole world."
+msgstr ""
+
+msgid "GNU|Linux|Unix|Free software|Libre software|Operating system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile Scheme|Transactional upgrades|Functional package management|Reproducibility"
+msgstr ""
+
+msgid "<1/>Summary"
+msgstr ""
+
+msgid "<1/> Guix is an advanced\n        distribution of the  developed by the —which respects the . "
+msgstr ""
+
+msgid "<1/> Guix  transactional upgrades and roll-backs, unprivileged\n        package management, .  When used as a standalone distribution, Guix supports  for transparent and reproducible operating systems."
+msgstr ""
+
+msgid "<1/> It provides  APIs, including high-level embedded domain-specific\n        languages (EDSLs) to  and ."
+msgstr ""
+
+msgid "<1/>DOWNLOAD v"
+msgstr ""
+
+msgid "CONTRIBUTE"
+msgstr ""
+
+msgid "<1/>Discover Guix"
+msgstr ""
+
+msgid "<1/>Guix comes with thousands of packages which include\n       applications, system tools, documentation, fonts, and other\n       digital goods readily available for installing with the  package manager."
+msgstr ""
+
+msgid "ALL PACKAGES"
+msgstr ""
+
+msgid "<1/>GNU Guix in your field"
+msgstr ""
+
+msgid "<1/>Read some stories about how people are using GNU\xa0Guix in their daily\n       lives."
+msgstr ""
+
+msgid "BIOINFORMATICS"
+msgstr ""
+
+msgid "HIGH PERFORMANCE COMPUTING"
+msgstr ""
+
+msgid "RESEARCH"
+msgstr ""
+
+msgid "ALL FIELDS..."
+msgstr ""
+
+msgid "<1/>GNU Guix in other GNU/Linux distros"
+msgstr ""
+
+msgid "<1/>Video:  (1 minute, 30 seconds)."
+msgstr ""
+
+msgid "<1/>"
+msgstr ""
+
+msgid "TRY IT OUT!"
+msgstr ""
+
+msgid "<1/>Blog"
+msgstr ""
+
+msgid "ALL POSTS"
+msgstr ""
+
+msgid "<1/>Contact"
+msgstr ""
+
+msgid "ALL CONTACT MEDIA"
+msgstr ""
diff --git a/website/scripts/sexp-xgettext.scm b/website/scripts/sexp-xgettext.scm
new file mode 100644
index 0000000..c069507
--- /dev/null
+++ b/website/scripts/sexp-xgettext.scm
@@ -0,0 +1,575 @@
+;;; GNU Guix web site
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
+;;;
+;;; This file is part of the GNU Guix web site.
+;;;
+;;; The GNU Guix web site is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; The GNU Guix web site 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 Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with the GNU Guix web site.  If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (ice-9 getopt-long)
+             (ice-9 match)
+             (ice-9 peg)
+             (ice-9 receive)
+             (ice-9 regex)
+             (ice-9 textual-ports)
+             (srfi srfi-1) ;lists
+             (srfi srfi-9)) ;records
+
+;;; This script imitates xgettext, but combines nested s-expressions
+;;; in the input Scheme files to a single msgstr in the PO file.  It
+;;; works by first reading the keywords specified on the command-line,
+;;; then dealing with the remaining options using (ice-9 getopt-long).
+;;; Then, it parses each Scheme file in the POTFILES file specified
+;;; with --files-from and constructs po entries from it.  For parsing,
+;;; a PEG is used instead of Scheme’s read, because we can extract
+;;; comments with it.  The po entries are written to the PO file
+;;; specified with the --output option.  Scheme code can then use the
+;;; (sexp-xgettext) module to deconstruct the msgids looked up in the
+;;; PO file via gettext.
+
+(define (pk a)
+  (begin
+    (write a)
+    (newline)
+    a))
+
+(define-record-type <keyword-spec>
+  (make-keyword-spec id sg pl c total xcomment)
+  keyword-spec?
+  (id keyword-spec-id) ;identifier
+  (sg keyword-spec-sg) ;arg with singular
+  (pl keyword-spec-pl) ;arg with plural
+  (c keyword-spec-c) ;arg with msgctxt or 'mixed if sg is mixed msgctxt|singular
+  (total keyword-spec-total) ;total number of args
+  (xcomment keyword-spec-xcomment))
+
+(define (complex-keyword-spec? keyword-spec)
+  (match keyword-spec
+    (($ <keyword-spec> _ _ #f #f _ #f) #f)
+    (else #t)))
+
+(define %keyword-specs
+  ;; List of valid keywords.
+  (let loop ((opts (cdr (command-line)));command-line options from
+                                        ;which to extract --keyword
+                                        ;options
+             (remaining-opts '()) ;unhandled opts
+             (specs '()))
+    ;; Read keywords from command-line options.
+    (define (string->integer str)
+      (if (string-match "[0-9]+" str)
+          (string->number str)
+          (error "Not a decimal integer.")))
+    (define* (argnums->spec id #:optional (argnums '()))
+      (let loop ((sg #f)
+                 (pl #f)
+                 (c #f)
+                 (total #f)
+                 (xcomment #f)
+                 (argnums argnums))
+        (match argnums
+          (() (make-keyword-spec id
+                                 (if sg sg 1)
+                                 pl
+                                 c
+                                 total
+                                 xcomment))
+          ((arg . argnums)
+           (cond
+            ((string-suffix? "c" arg)
+             (cond (c (error "c suffix clashes"))
+                   (else
+                    (let* ((number-str (string-drop-right arg 1))
+                           (number (string->integer number-str)))
+                      (loop sg pl number total xcomment argnums)))))
+            ((string-suffix? "g" arg)
+             (cond
+              (sg (error "Only first argnum can have g suffix."))
+              (c (error "g suffix clashes."))
+              (else
+               (let* ((number-str (string-drop-right arg 1))
+                      (number (string->integer number-str)))
+                 (loop number #f 'mixed total xcomment argnums)))))
+            ((string-suffix? "t" arg)
+             (cond (total (error "t suffix clashes"))
+                   (else
+                    (let* ((number-str (string-drop-right arg 1))
+                           (number (string->integer number-str)))
+                      (loop sg pl c number xcomment argnums)))))
+            ((string-suffix? "\"" arg)
+             (cond (xcomment (error "xcomment clashes"))
+                   (else
+                    (let* ((comment (substring arg
+                                               1
+                                               (- (string-length arg) 1))))
+                      (loop sg pl c total comment argnums)))))
+            (else
+             (let* ((number (string->integer arg)))
+               (if sg
+                   (if pl
+                       (error "Too many argnums.")
+                       (loop sg number c total xcomment argnums))
+                   (loop number #f c total xcomment argnums)))))))))
+
+    (define (string->spec str) ;see `info xgettext`
+      (match (string-split str #\:)
+        ((id) (argnums->spec id))
+        ((id argnums)
+         (argnums->spec id (string-split argnums #\,)))))
+    (match opts
+      (() (begin
+            ;; remove recognized --keyword command-line options:
+            (set-program-arguments (cons (car (command-line))
+                                         (reverse remaining-opts)))
+            specs))
+      ((current-opt . rest)
+       (cond
+        ((string=? "--" current-opt) specs)
+        ((string-prefix? "--keyword=" current-opt)
+         (let ((keyword (string-drop current-opt (string-length "--keyword="))))
+           (loop rest remaining-opts (cons (string->spec keyword) specs))))
+        ((or (string=? "--keyword" current-opt)
+             (string=? "-k" current-opt))
+         (let ((next-opt (car rest)))
+           (loop (cdr rest)
+                 remaining-opts
+                 (cons (string->spec next-opt) specs))))
+        (else (loop rest (cons current-opt remaining-opts) specs)))))))
+
+;;; Other options are not repeated, so we can use getopt-long:
+
+(define %options ;; Corresponds to what is documented at `info xgettext`.
+  (let ((option-spec
+         `((files (single-char #\f) (value #t))
+           (directory (single-char #\D) (value #t))
+           (default-domain (single-char #\d) (value #t))
+           (output (single-char #\o) (value #t))
+           (output-dir (single-char #\p) (value #t))
+           (from-code (value #t))
+           (join-existing (single-char #\j) (value #f))
+           (exclude-file (single-char #\x) (value #t))
+           (add-comments (single-char #\c) (value #t))
+
+           ;; Because getopt-long does not support repeated options,
+           ;; we took care of --keyword options further up.
+           ;; (keyword (single-char #\k) (value #t))
+
+           (flag (value #t))
+           (force-po (value #f))
+           (indent (single-char #\i) (value #f))
+           (no-location (value #f))
+           (add-location (single-char #\n) (value #t))
+           (width (single-char #\w) (value #t))
+           (no-wrap (value #f))
+           (sort-output (single-char #\s) (value #f))
+           (sort-by-file (single-char #\F) (value #f))
+           (omit-header (value #f))
+           (copyright-holder (value #t))
+           (foreign-user (value #f))
+           (package-name (value #t))
+           (package-version (value #t))
+           (msgid-bugs-address (value #t))
+           (msgstr-prefix (single-char #\m) (value #t))
+           (msgstr-suffix (single-char #\m) (value #t))
+           (help (value #f))
+           (pack (value #f)))))
+    (getopt-long (command-line) option-spec)))
+
+
+;; implemented similar to guix/build/po.scm
+(define parse-scheme-file
+  ;; This procedure parses FILE and returns a parse tree.
+  (let ()
+    ;;TODO: OPTIONALLY IGNORE CASE:
+    (define-peg-pattern comment all (and ";"
+                                         (* (and peg-any
+                                                 (not-followed-by "\n")))
+                                         (and peg-any (followed-by "\n"))))
+    (define-peg-pattern whitespace none (or " " "\t" "\n"))
+    (define-peg-pattern quotation body (or "'" "`" "," ",@")) ;TODO ALLOW USER TO SPECIFY OTHER QUOTE CHARACTERS
+    (define-peg-pattern open body (and (? quotation)
+                                       (or "(" "[" "{")))
+    (define-peg-pattern close body (or ")" "]" "}"))
+    (define-peg-pattern string body (and (followed-by "\"")
+                                         (* (or "\\\""
+                                                (and peg-any
+                                                     (not-followed-by "\""))))
+                                         (and peg-any (followed-by "\""))
+                                         "\""))
+    (define-peg-pattern token all (or string
+                                      (and
+                                       (not-followed-by open)
+                                       (not-followed-by close)
+                                       (not-followed-by comment)
+                                       (* (and peg-any
+                                               (not-followed-by open)
+                                               (not-followed-by close)
+                                               (not-followed-by comment)
+                                               (not-followed-by string)
+                                               (not-followed-by whitespace)))
+                                       (or
+                                        (and peg-any (followed-by open))
+                                        (and peg-any (followed-by close))
+                                        (and peg-any (followed-by comment))
+                                        (and peg-any (followed-by string))
+                                        (and peg-any (followed-by whitespace))
+                                        (not-followed-by peg-any)))))
+    (define-peg-pattern sexp all (or (and (? quotation) "(" program ")")
+                                     (and (? quotation) "[" program "]")
+                                     (and (? quotation) "{" program "}")))
+    (define-peg-pattern t-or-s body (or token sexp))
+    (define-peg-pattern program all (* (or whitespace
+                                           comment
+                                           t-or-s)))
+    (lambda (file)
+      (call-with-input-file file
+        (lambda (port)
+          ;; it would be nice to match port directly without
+          ;; converting to a string first
+          (let ((string (get-string-all port)))
+            (peg:tree (match-pattern program string))))))))
+
+
+(define-record-type <po-entry>
+  (make-po-entry ecomments ref flags ctxt id idpl)
+  po-entry?
+;;; irrelevant: (tcomments po-entry-tcomments) ;translator-comments
+  (ecomments po-entry-ecomments) ;extracted-comments
+  (ref po-entry-ref) ;reference
+  (flags po-entry-flags)
+;;; irrelevant: (prevctxt po-entry-prevctxt) ;previous-ctxt
+;;; irrelevant: (prev po-entry-prev) ;previous-translation
+  (ctxt po-entry-ctxt) ;msgctxt
+  (id po-entry-id) ;msgid
+  (idpl po-entry-idpl) ;msgid-plural
+;;; irrelevant: (str po-entry-str) ;msgstr string or association list
+;;;                                ;integer to string
+  )
+
+(define (write-po-entry po-entry)
+  (define* (write-component c prefix #:optional (out display))
+    (when c
+      (begin (display prefix)
+             (display " ")
+             (out c)
+             (newline))))
+  (match po-entry
+    (($ <po-entry> ecomments ref flags ctxt id idpl)
+     (write-component ecomments "#.")
+     (write-component ref "#:")
+     (write-component flags "#,")
+     (write-component ctxt "msgctxt" write)
+     (write-component id "msgid" write)
+     (write-component idpl "msgid_plural" write)
+     (display "msgstr \"\"")
+     (newline))))
+
+(define %ecomments-string
+  (make-parameter #f))
+
+(define (update-ecomments-string! str)
+  "Sets the value of the parameter object %ecomments-string if str is
+an ecomments string.  An ecomments string is extracted from a comment
+because it starts with TRANSLATORS or a key specified with
+--add-comments." ;TODO NOT IMPLEMENTED YET
+  (when (string-prefix? "TRANSLATORS" str)
+    (%ecomments-string str))) ;TODO NOT THE WHOLE STRING
+
+(define %line-number
+  (make-parameter #f))
+
+(define (update-line-number! number)
+  "Sets the value of the parameter object %line-number to NUMBER."
+  (%line-number number))
+
+(define (incr-line-number!)
+  "Increments the value of the parameter object %line-number by 1."
+  (%line-number (1+ %line-number)))
+
+(define (make-simple-po-entry msgid)
+  (make-po-entry
+   (%ecomments-string)
+   (%line-number)
+   #f ;TODO use scheme-format for format strings?
+   #f ;no ctxt
+   msgid
+   #f))
+
+
+(define (matching-keyword id)
+  "Returns the keyword-spec whose identifier is the same as ID, or #f
+if ID is no string or no such keyword-spec exists."
+  (and (symbol? id)
+       (let ((found (member (symbol->string id)
+                            %keyword-specs
+                            (lambda (id spec)
+                              (string=? id (keyword-spec-id spec))))))
+         (and found (car found)))))
+
+(define (nth-exp program n)
+  "Returns the nth 'token or 'sexp inside the PROGRAM parse tree or #f
+if no tokens or sexps exist."
+  (let loop ((i 0)
+             (rest program))
+    (define (on-hit exp)
+      (if (= i n) exp
+          ;; else:
+          (loop (1+ i) (cdr rest))))
+    (match rest
+      (() #f)
+      ((('token exp) . _) (on-hit (car rest)))
+      ((('sexp open-paren exp close-paren) . _) (on-hit (car rest)))
+      ((_ . _) (loop i (cdr rest)))
+      (else #f))))
+
+(define (more-than-one-exp? program)
+  "Returns true if PROGRAM consiste of more than one expression."
+  (if (matching-keyword (token->string-or-symbol (nth-exp program 0)))
+      (nth-exp program 2) ;if there is third element, keyword does not count
+      (nth-exp program 1)))
+
+(define (token->string-or-symbol tok)
+  "For a parse tree TOK, if it is a 'token parse tree, returns its
+value as a string or symbol, otherwise returns #f."
+  (match tok
+    (('token exp)
+     (with-input-from-string exp
+       (lambda ()
+         (read))))
+    (else #f)))
+
+(define (complex-marked-sexp->po-entries parse-tree)
+  "Checks if PARSE-TREE is marked by a keyword.  If yes, for a complex
+keyword spec, returns a list of po-entries for it.  For a simple
+keyword spec, returns the argument number of its singular form.
+Otherwise returns #f."
+  (let* ((first (nth-exp parse-tree 0))
+         (spec (matching-keyword (token->string-or-symbol first))))
+    (if spec
+        (if ;if the identifier of a complex keyword occurs first
+         (complex-keyword-spec? spec)
+         ;; then make po entries for it
+         (match spec
+           (($ <keyword-spec> id sg pl c total xcomment)
+            (if (eq? c 'mixed) ; if msgctxt and singular msgid are in one string
+                (let* ((exp (nth-exp parse-tree sg))
+                       (val (token->string-or-symbol exp))
+                       (idx (if (string? val) (string-rindex val #\|))))
+                  (list (make-po-entry
+                         (%ecomments-string)
+                         (%line-number)
+                         #f ;TODO use scheme-format for format strings?
+                         (string-take val idx)
+                         (string-drop val (1+ idx))
+                         #f))) ;plural forms are not supported
+                ;; else construct msgids
+                (receive (pl-id pl-entries)
+                    (match pl
+                      (#t (construct-msgid-and-po-entries
+                           (nth-exp parse-tree pl)))
+                      (#f (values #f '())))
+                  (receive (sg-id sg-entries)
+                      (construct-msgid-and-po-entries
+                       (nth-exp parse-tree sg))
+                    (cons
+                     (make-po-entry
+                      (%ecomments-string)
+                      (%line-number)
+                      #f ;TODO use scheme-format for format strings?
+                      (and c (token->string-or-symbol (nth-exp parse-tree c)))
+                      sg-id
+                      pl-id)
+                     (append sg-entries pl-entries)))))))
+         ;; else if it is a simple keyword, return the argnum:
+         (keyword-spec-sg spec))
+        ;; if no keyword occurs, then false
+        #f)))
+
+(define (construct-po-entries parse-tree)
+  "Converts a PARSE-TREE resulting from a call to parse-scheme-file to
+a list of po-entry records.  Unlike construct-msgid-and-po-entries,
+strings are not collected to a msgid.  The list of po-entry records is
+the return value."
+  (let ((entries (complex-marked-sexp->po-entries parse-tree)))
+    (cond
+     ((list? entries) entries)
+     ((number? entries) ;parse-tree yields a single, simple po entry
+      (receive (id entries)
+          (construct-msgid-and-po-entries
+           (nth-exp parse-tree entries))
+        (cons (make-simple-po-entry id)
+              entries)))
+     (else ;search for marked translations in parse-tree
+      (match parse-tree
+        (() '())
+        (('comment str) (begin
+                          (update-ecomments-string! str)
+                          '()))
+        ;; TODO UPDATE %line-number ON NL
+        (('token str) '())
+        (('sexp open-paren program close-paren)
+         (construct-po-entries program))
+        (('program . components)
+         (append-map construct-po-entries components)))))))
+
+(define* (tag counter prefix #:key (flavor 'start))
+  "Formats the number COUNTER as a tag according to FLAVOR, which is
+either 'start, 'end or 'empty for a start, end or empty tag,
+respectively."
+  (string-append "<"
+                 (if (eq? flavor 'end) "/" "")
+                 prefix
+                 (number->string counter)
+                 (if (eq? flavor 'empty) "/" "")
+                 ">"))
+
+(define-record-type <construct-fold-state>
+  (make-construct-fold-state msgid-string counter po-entries)
+  construct-fold-state?
+  (msgid-string construct-fold-state-msgid-string)
+  (counter construct-fold-state-counter)
+  (po-entries construct-fold-state-po-entries))
+
+(define* (construct-msgid-and-po-entries parse-tree
+                                         #:optional
+                                         (prefix ""))
+  "Like construct-po-entries, but with two return values.  The first
+is an accumulated msgid constructed from all components in PARSE-TREE
+for use in make-po-entry.  Non-strings are replaced by tags containing
+PREFIX.  The second return value is a list of po entries for
+subexpressions marked with a complex keyword spec."
+  (match parse-tree
+    (() (values "" '()))
+    (('comment str) (begin
+                      (update-ecomments-string! str)
+                      (values "" '())))
+    ;; TODO UPDATE %line-number ON NL
+    (('token exp)
+     (let ((maybe-string (token->string-or-symbol parse-tree)))
+       (if (string? maybe-string)
+           (values maybe-string '())
+           (error "Single symbol marked for translation." maybe-string))))
+    (('sexp open-paren program close-paren)
+     ;; parse program instead
+     (construct-msgid-and-po-entries program prefix))
+    (('program . components)
+     ;; Concatenate strings in parse-tree to a new msgid and add an
+     ;; <x> tag for each sexp in between.
+     (match
+         (fold
+          (lambda (component prev-state)
+            (match prev-state
+              (($ <construct-fold-state> msgid-string counter po-entries)
+               (match component
+                 (('comment str) (begin (update-ecomments-string! str)
+                                        prev-state))
+                 ;; TODO INCREASE %line-number ON NL
+                 (('token exp)
+                  (let ((maybe-string (token->string-or-symbol component)))
+                    (cond
+                     ((string? maybe-string)
+                      ;; if string, append maybe-string to previous msgid
+                      (make-construct-fold-state
+                       (string-append msgid-string maybe-string)
+                       counter
+                       po-entries))
+                     ((and (more-than-one-exp? components) ;not the only symbol
+                           (or (string-null? msgid-string) ;no string so far
+                               (string-suffix? ">" msgid-string))) ;tag before
+                      prev-state) ;then ignore
+                     ((matching-keyword maybe-string)
+                      prev-state) ;ignore keyword token)
+                     (else ;append tag representing the token
+                      (make-construct-fold-state
+                       (string-append msgid-string
+                                      (tag counter prefix
+                                           #:flavor 'empty))
+                       (1+ counter)
+                       po-entries)))))
+                 (('sexp open-paren program close-paren)
+                  (let ((first (nth-exp program 0)))
+                    (match (complex-marked-sexp->po-entries program)
+                      ((? list? result)
+                       (make-construct-fold-state
+                        (string-append msgid-string
+                                       (tag counter prefix #:flavor 'empty))
+                        (1+ counter)
+                        (append result po-entries)))
+                      (result
+                       (if (or (number? result)
+                               (not (more-than-one-exp? components)))
+                           (receive (id entries)
+                               (construct-msgid-and-po-entries
+                                program
+                                (string-append prefix (number->string counter)
+                                               "."))
+                             (make-construct-fold-state
+                              (string-append msgid-string
+                                             (tag counter prefix
+                                                  #:flavor 'start)
+                                             id
+                                             (tag counter prefix
+                                                  #:flavor 'end))
+                              (1+ counter)
+                              (append entries po-entries)))
+                           ;; else ignore unmarked sexp
+                           prev-state)))))))))
+          (make-construct-fold-state "" 1 '())
+          components)
+       (($ <construct-fold-state> msgid-string counter po-entries)
+        (values msgid-string po-entries))))))
+
+(define scheme-file->po-entries
+  (compose construct-po-entries
+           parse-scheme-file))
+
+(define %files-from-port
+  (let ((files-from (option-ref %options 'files #f)))
+    (if files-from
+        (open-input-file files-from)
+        (current-input-port))))
+
+(define %scheme-files
+  (let loop ((line (get-line %files-from-port))
+             (scheme-files '()))
+    (if (eof-object? line)
+        (begin
+          (close-port %files-from-port)
+          scheme-files)
+        ;; else read file names before comment
+        (let ((before-comment (car (string-split line #\#))))
+          (loop (get-line %files-from-port)
+                (append
+                 (map match:substring (list-matches "[^ \t]+" line))
+                 scheme-files))))))
+
+(define %output-po-entries
+  (fold (lambda (scheme-file po-entries)
+          (append (scheme-file->po-entries scheme-file)
+                  po-entries))
+        '()
+        %scheme-files))
+
+(define %output-port
+  (let ((output (option-ref %options 'output #f)))
+    (if output
+        (open-output-file output)
+        (current-output-port))))
+
+(with-output-to-port %output-port
+  (lambda ()
+    (for-each (lambda (po-entry)
+                (begin
+                  (newline)
+                  (write-po-entry po-entry)))
+              %output-po-entries)))
diff --git a/website/sexp-xgettext.scm b/website/sexp-xgettext.scm
new file mode 100644
index 0000000..2378d3f
--- /dev/null
+++ b/website/sexp-xgettext.scm
@@ -0,0 +1,31 @@
+;;; GNU Guix web site
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
+;;;
+;;; This file is part of the GNU Guix web site.
+;;;
+;;; The GNU Guix web site is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; The GNU Guix web site 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 Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with the GNU Guix web site.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (sexp-xgettext)
+  #:export (%current-mo-file
+            mo-lookup))
+
+(define %current-mo-file
+  (make-parameter #f))
+
+(define (mo-lookup msg #:key number msgctxt)
+  "Return the translation of MSG from the %CURRENT-MO-FILE for
+NUMBER (like n in ngettext) that has the specified MSGCTXT (like
+pgettext)."
+  ;; TODO CURRENTLY THIS FUNCTION USES guix/build/po.scm TO LOOK UP
+  ;; TRANSLATIONS FROM A PO FILE AND NOT FROM AN MO FILE
diff --git a/website/wip-howto-test-translation b/website/wip-howto-test-translation
new file mode 100644
index 0000000..362ef08
--- /dev/null
+++ b/website/wip-howto-test-translation
@@ -0,0 +1,27 @@
+To create a pot file:
+
+guile scripts/sexp-xgettext.scm -f po/POTFILES -o po/guix-website.pot --from-code=UTF-8 --copyright-holder="Ludovic Courtès" --package-name="guix-website" --msgid-bugs-address="ludo@gnu.org" --keyword=G_ --keyword=N_:1,2 --keyword=C_:1,2c
+
+To create a po file from a pot file, do the usual:
+
+cd po
+msginit -l de --no-translator
+
+To merge an existing po file with a new pot file:
+
+cd po
+msgmerge -U de.po guix-website.pot
+
+To update mo files:
+
+mkdir -p de/LC_MESSAGES
+cd po
+msgfmt de.po
+cd ..
+mv po/messages.mo de/LC_MESSAGES/guix-website.mo
+
+To test:
+
+guix environment --ad-hoc haunt
+GUILE_LOAD_PATH=$(guix build guile-syntax-highlight)/share/guile/site/2.2:$GUILE_LOAD_PATH GUIX_WEB_SITE_LOCAL=yes haunt build
+GUILE_LOAD_PATH=$(guix build guile-syntax-highlight)/share/guile/site/2.2:$GUILE_LOAD_PATH haunt serve
-- 
2.22.0


[-- Attachment #3: home.scm --]
[-- Type: application/vnd.lotus-screencam, Size: 7923 bytes --]

[-- Attachment #4: guix-website.pot --]
[-- Type: application/vnd.ms-powerpoint, Size: 2074 bytes --]

Re: Website translation

[pelzflorian (Florian Pelz)]

[-- Attachment #1: Type: text/plain, Size: 256 bytes --]

On Fri, Jul 26, 2019 at 01:11:56PM +0200, pelzflorian (Florian Pelz) wrote:
> Also attached is a file marked for
> translation and the POT file generated from it.

Of course I forgot to git add the current POT file and sent the wrong
one.  See attachment.

[-- Attachment #2: home.scm --]
[-- Type: application/vnd.lotus-screencam, Size: 7923 bytes --]

[-- Attachment #3: guix-website.pot --]
[-- Type: application/vnd.ms-powerpoint, Size: 3210 bytes --]

Re: Website translation

[pelzflorian (Florian Pelz)]

[-- Attachment #1: Type: text/plain, Size: 2397 bytes --]

On Fri, Jul 19, 2019 at 02:29:52PM +0200, pelzflorian (Florian Pelz) wrote:
> I will try writing a custom xgettext that combines
> nested·s-expressions·that are marked for translation with G_
> to·a·single·msgstr that gets written to the·PO·file.  This combined
> string will not be part of the source code but will be generated from
> a nested sexp.  The PO file containing the combined strings can then
> be translated as usual.  For reading the translation, the combined
> msgstr will be constructed again by the marking procedure G_ and
> looked up by reading from an MO file.
> 

I have implemented a working translation tool.  Sexp-xgettext
generates from an SHTML or other Scheme file with marked s-expressions
a POT file which can be translated and turned into an MO file from
which the code generates a localized HTML builder.  The advantage is
that existing SHTML will just have to be marked with G_ and no format
string has to be written, although sometimes the SHTML should be
adapted to produce a less complicated message in the POT file.  Find
attached an example of a marked Scheme file home.scm generating
guix-website.pot, which after manual translation generates the
attached guix.de_DE.html.

Marking a string for translation behaves like normal gettext.  Marking
a parenthesized expression (i.e. a list or procedure call) extracts
each string from the parenthesized expression.  If a symbol, keyword
or other parenthesized expression occurs between the strings, it is
extracted as an XML element.  Expressions before or after all strings
are not extracted.  If strings from a parenthesized sub-expression
shall be extracted too, the sub-expression must again be marked with
G_ unless it is the only sub-expression or it follows a quote,
unquote, quasiquote or unquote-splicing.  The order of XML elements
can be changed in the translation to produce a different ordering
inside a parenthesized expression.  If a string shall not be extracted
from a marked expression, it must be wrapped, for example by a call to
the identity procedure.

But there are still some bugs like missing line numbers and
non-working pgettext and the code is not clear enough yet.  I will
send a patch series tomorrow after I fixed these issues (even though
the documentation won’t be near as good as sirgazil’s format strings).

Regards,
Florian

[-- Attachment #2: home.scm --]
[-- Type: application/vnd.lotus-screencam, Size: 8067 bytes --]

[-- Attachment #3: guix-website.pot --]
[-- Type: application/vnd.ms-powerpoint, Size: 4474 bytes --]

[-- Attachment #4: guix.de_DE.html --]
[-- Type: text/html, Size: 10913 bytes --]

Re: Website translation

[pelzflorian (Florian Pelz)]

[-- Attachment #1: Type: text/plain, Size: 3032 bytes --]

On Mon, Aug 05, 2019 at 03:08:28PM +0200, pelzflorian (Florian Pelz) wrote:
> I have implemented a working translation tool.  Sexp-xgettext
> generates from an SHTML or other Scheme file with marked s-expressions
> a POT file which can be translated and turned into an MO file from
> which the code generates a localized HTML builder.  The advantage is
> that existing SHTML will just have to be marked with G_ and no format
> string has to be written, although sometimes the SHTML should be
> adapted to produce a less complicated message in the POT file.  Find
> attached an example of a marked Scheme file home.scm generating
> guix-website.pot, which after manual translation generates the
> attached guix.de_DE.html.
> 
> Marking a string for translation behaves like normal gettext.  Marking
> a parenthesized expression (i.e. a list or procedure call) extracts
> each string from the parenthesized expression.  If a symbol, keyword
> or other parenthesized expression occurs between the strings, it is
> extracted as an XML element.  Expressions before or after all strings
> are not extracted.  If strings from a parenthesized sub-expression
> shall be extracted too, the sub-expression must again be marked with
> G_ unless it is the only sub-expression or it follows a quote,
> unquote, quasiquote or unquote-splicing.  The order of XML elements
> can be changed in the translation to produce a different ordering
> inside a parenthesized expression.  If a string shall not be extracted
> from a marked expression, it must be wrapped, for example by a call to
> the identity procedure.
> 
> But there are still some bugs like missing line numbers and
> non-working pgettext and the code is not clear enough yet.  I will
> send a patch series tomorrow after I fixed these issues (even though
> the documentation won’t be near as good as sirgazil’s format strings).
> 

Find attached patches that add internationalization support, mark the
home and about pages for translation and add a sample German
translation.  Feedback welcome.

To use them, generate an MO file and run Haunt by following the
instructions in i18n-howto.txt.  I have *not* written a Makefile to
automate these steps.

Sending these patches took longer because new bugs kept appearing.
Probably new bugs will show up when marking more files for
translation.  I will add more markings in the coming days if the
patches are OK.

I am unsure but I believe the URLs in href links should be marked with
G_ as well so translators can change them to the URL of the respective
translation of gnu.org, for example.  I will make these changes later
if you agree.

If this internationalization is to be deployed, the NGINX server
offering guix.gnu.org would need to redirect according to
Accept-Language headers.  I do not know if nginx alone can do this
properly by now, otherwise there are Lua programs for nginx to handle
Accept-Language or a custom Guile webserver could be written.

Regards,
Florian

[-- Attachment #2: 0001-website-Use-needed-modules-in-posts.patch --]
[-- Type: text/plain, Size: 1529 bytes --]

From 979cf0ee1f9276c133626d64b460a52d1702d7c0 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Thu, 18 Jul 2019 10:22:44 +0200
Subject: [PATCH 1/6] website: Use needed modules in posts.

* website/posts/back-from-seagl-2018.sxml: Use needed modules.
* website/posts/guix-at-libreplanet-2016.sxml: Use needed modules.
---
 website/posts/back-from-seagl-2018.sxml     | 3 ++-
 website/posts/guix-at-libreplanet-2016.sxml | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/website/posts/back-from-seagl-2018.sxml b/website/posts/back-from-seagl-2018.sxml
index c5ad0a9..958369f 100644
--- a/website/posts/back-from-seagl-2018.sxml
+++ b/website/posts/back-from-seagl-2018.sxml
@@ -1,6 +1,7 @@
 (begin
   (use-modules (apps base templates components)
-	           (srfi srfi-19))
+               (apps base utils)
+               (srfi srfi-19))
   `((title . "Back from SeaGL 2018")
     (author . "Chris Marusich")
     (date . ,(make-date 0 0 0 0 10 12 2018 -28800))
diff --git a/website/posts/guix-at-libreplanet-2016.sxml b/website/posts/guix-at-libreplanet-2016.sxml
index 8581be4..252def3 100644
--- a/website/posts/guix-at-libreplanet-2016.sxml
+++ b/website/posts/guix-at-libreplanet-2016.sxml
@@ -1,5 +1,6 @@
 (begin
-  (use-modules (srfi srfi-19))
+  (use-modules (srfi srfi-19)
+               (apps base templates components))
   `((title . "Guix at LibrePlanet 2016")
     (author . "David Thompson")
     (date unquote (make-date 0 0 0 0 15 3 2016 3600))
-- 
2.22.0


[-- Attachment #3: 0002-website-Add-custom-xgettext-implementation-that-extr.patch --]
[-- Type: text/plain, Size: 61753 bytes --]

From b5b7d9232d5144a4296c3c9c60034628f8146eec Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Wed, 7 Aug 2019 23:48:59 +0200
Subject: [PATCH 2/6] website: Add custom xgettext implementation that extracts
 from nested sexps.

* website/scripts/sexp-xgettext.scm: New file for generating a PO file.
* website/sexp-xgettext.scm: New file with module for looking up
translations.
* website/i18n-howto: New file with usage instructions.
---
 website/i18n-howto.txt            |  63 +++
 website/scripts/sexp-xgettext.scm | 814 ++++++++++++++++++++++++++++++
 website/sexp-xgettext.scm         | 454 +++++++++++++++++
 3 files changed, 1331 insertions(+)
 create mode 100644 website/i18n-howto.txt
 create mode 100644 website/scripts/sexp-xgettext.scm
 create mode 100644 website/sexp-xgettext.scm

diff --git a/website/i18n-howto.txt b/website/i18n-howto.txt
new file mode 100644
index 0000000..66d19d0
--- /dev/null
+++ b/website/i18n-howto.txt
@@ -0,0 +1,63 @@
+With sexp-xgettext, arbitrary s-expressions can be marked for
+translations (not only strings like with normal xgettext).
+
+S-expressions can be marked with G_ (simple marking for translation),
+N_ (“complex” marking with different forms depending on number like
+ngettext), C_ (“complex” marking distinguished from other markings by
+a msgctxt like pgettext) or NC_ (mix of both).
+
+Marking a string for translation behaves like normal gettext.  Marking
+a parenthesized expression (i.e. a list or procedure call) extracts
+each string from the parenthesized expression.  If a symbol, keyword
+or other parenthesized expression occurs between the strings, it is
+extracted as an XML element.  Expressions before or after all strings
+are not extracted.  If strings from a parenthesized sub-expression
+shall be extracted too, the sub-expression must again be marked with
+G_ unless it is the only sub-expression or it follows a quote,
+unquote, quasiquote or unquote-splicing.  The order of XML elements
+can be changed in the translation to produce a different ordering
+inside a parenthesized expression.  If a string shall not be extracted
+from a marked expression, it must be wrapped, for example by a call to
+the identity procedure.  Be careful when marking non-SHTML content
+such as procedure calls for translation: Additional strings will be
+inserted between non-string elements.
+
+Known issues:
+
+* Line numbers are sometimes off.
+
+* Some less important other TODOs in the comments.
+
+=====
+
+To create a pot file:
+
+guile scripts/sexp-xgettext.scm -f po/POTFILES -o po/guix-website.pot --from-code=UTF-8 --copyright-holder="Ludovic Courtès" --package-name="guix-website" --msgid-bugs-address="ludo@gnu.org" --keyword=G_ --keyword=N_:1,2 --keyword=C_:1c,2 --keyword=NC_:1c,2,3
+
+To create a po file from a pot file, do the usual:
+
+cd po
+msginit -l de --no-translator
+
+To merge an existing po file with a new pot file:
+
+cd po
+msgmerge -U de.po guix-website.pot
+
+To update mo files:
+
+mkdir -p de/LC_MESSAGES
+cd po
+msgfmt de.po
+cd ..
+mv po/messages.mo de/LC_MESSAGES/guix-website.mo
+
+To test:
+
+guix environment --ad-hoc haunt
+GUILE_LOAD_PATH=$(guix build guile-syntax-highlight)/share/guile/site/2.2:$GUILE_LOAD_PATH GUIX_WEB_SITE_LOCAL=yes haunt build
+GUILE_LOAD_PATH=$(guix build guile-syntax-highlight)/share/guile/site/2.2:$GUILE_LOAD_PATH haunt serve
+
+For checking for errors / debugging newly marked files e.g.:
+
+GUILE_LOAD_PATH=.:$(guix build haunt)/share/guile/site/2.2:$GUILE_LOAD_PATH guile apps/base/templates/about.scm
diff --git a/website/scripts/sexp-xgettext.scm b/website/scripts/sexp-xgettext.scm
new file mode 100644
index 0000000..634c716
--- /dev/null
+++ b/website/scripts/sexp-xgettext.scm
@@ -0,0 +1,814 @@
+;;; GNU Guix web site
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
+;;;
+;;; This file is part of the GNU Guix web site.
+;;;
+;;; The GNU Guix web site is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; The GNU Guix web site 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 Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with the GNU Guix web site.  If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (ice-9 getopt-long)
+             (ice-9 match)
+             (ice-9 peg)
+             (ice-9 receive)
+             (ice-9 regex)
+             (ice-9 textual-ports)
+             (srfi srfi-1) ;lists
+             (srfi srfi-9) ;records
+             (srfi srfi-19) ;date
+             (srfi srfi-26)) ;cut
+
+;;; This script imitates xgettext, but combines nested s-expressions
+;;; in the input Scheme files to a single msgstr in the PO file.  It
+;;; works by first reading the keywords specified on the command-line,
+;;; then dealing with the remaining options using (ice-9 getopt-long).
+;;; Then, it parses each Scheme file in the POTFILES file specified
+;;; with --files-from and constructs po entries from it.  For parsing,
+;;; a PEG is used instead of Scheme’s read, because we can extract
+;;; comments with it.  The po entries are written to the PO file
+;;; specified with the --output option.  Scheme code can then use the
+;;; (sexp-xgettext) module to deconstruct the msgids looked up in the
+;;; PO file via gettext.
+
+(define-record-type <keyword-spec>
+  (make-keyword-spec id sg pl c total xcomment)
+  keyword-spec?
+  (id keyword-spec-id) ;identifier
+  (sg keyword-spec-sg) ;arg with singular
+  (pl keyword-spec-pl) ;arg with plural
+  (c keyword-spec-c) ;arg with msgctxt or 'mixed if sg is mixed msgctxt|singular
+  (total keyword-spec-total) ;total number of args
+  (xcomment keyword-spec-xcomment))
+
+(define (complex-keyword-spec? keyword-spec)
+  (match keyword-spec
+    (($ <keyword-spec> _ _ #f #f _ #f) #f)
+    (else #t)))
+
+(define %keyword-specs
+  ;; List of valid xgettext keyword options.
+  ;; Read keywords from command-line options.
+  (let loop ((opts (cdr (command-line)));command-line options from
+                                        ;which to extract --keyword
+                                        ;options
+             (remaining-opts '()) ;unhandled opts
+             (specs '()))
+    (define (string->integer str)
+      (if (string-match "[0-9]+" str)
+          (string->number str)
+          (error "Not a decimal integer.")))
+    (define* (argnums->spec id #:optional (argnums '()))
+      (let loop ((sg #f)
+                 (pl #f)
+                 (c #f)
+                 (total #f)
+                 (xcomment #f)
+                 (argnums argnums))
+        (match argnums
+          (() (make-keyword-spec id
+                                 (if sg sg 1)
+                                 pl
+                                 c
+                                 total
+                                 xcomment))
+          ((arg . argnums)
+           (cond
+            ((string-suffix? "c" arg)
+             (cond (c (error "c suffix clashes"))
+                   (else
+                    (let* ((number-str (string-drop-right arg 1))
+                           (number (string->integer number-str)))
+                      (loop sg pl number total xcomment argnums)))))
+            ((string-suffix? "g" arg)
+             (cond
+              (sg (error "Only first argnum can have g suffix."))
+              (c (error "g suffix clashes."))
+              (else
+               (let* ((number-str (string-drop-right arg 1))
+                      (number (string->integer number-str)))
+                 (loop number #f 'mixed total xcomment argnums)))))
+            ((string-suffix? "t" arg)
+             (cond (total (error "t suffix clashes"))
+                   (else
+                    (let* ((number-str (string-drop-right arg 1))
+                           (number (string->integer number-str)))
+                      (loop sg pl c number xcomment argnums)))))
+            ((string-suffix? "\"" arg)
+             (cond (xcomment (error "xcomment clashes"))
+                   (else
+                    (let* ((comment (substring arg
+                                               1
+                                               (- (string-length arg) 1))))
+                      (loop sg pl c total comment argnums)))))
+            (else
+             (let* ((number (string->integer arg)))
+               (if sg
+                   (if pl
+                       (error "Too many argnums.")
+                       (loop sg number c total xcomment argnums))
+                   (loop number #f c total xcomment argnums)))))))))
+
+    (define (string->spec str) ;see `info xgettext`
+      (match (string-split str #\:)
+        ((id) (argnums->spec id))
+        ((id argnums)
+         (argnums->spec id (string-split argnums #\,)))))
+    (match opts
+      (() (begin
+            ;; remove recognized --keyword command-line options:
+            (set-program-arguments (cons (car (command-line))
+                                         (reverse remaining-opts)))
+            specs))
+      ((current-opt . rest)
+       (cond
+        ((string=? "--" current-opt) specs)
+        ((string-prefix? "--keyword=" current-opt)
+         (let ((keyword (string-drop current-opt (string-length "--keyword="))))
+           (loop rest remaining-opts (cons (string->spec keyword) specs))))
+        ((or (string=? "--keyword" current-opt)
+             (string=? "-k" current-opt))
+         (let ((next-opt (car rest)))
+           (loop (cdr rest)
+                 remaining-opts
+                 (cons (string->spec next-opt) specs))))
+        (else (loop rest (cons current-opt remaining-opts) specs)))))))
+
+;;; Other options are not repeated, so we can use getopt-long:
+
+(define %options ;; Corresponds to what is documented at `info xgettext`.
+  (let ((option-spec
+         `((files (single-char #\f) (value #t))
+           (directory (single-char #\D) (value #t))
+           (default-domain (single-char #\d) (value #t))
+           (output (single-char #\o) (value #t))
+           (output-dir (single-char #\p) (value #t))
+           (from-code (value #t))
+           (join-existing (single-char #\j) (value #f))
+           (exclude-file (single-char #\x) (value #t))
+           (add-comments (single-char #\c) (value #t))
+
+           ;; Because getopt-long does not support repeated options,
+           ;; we took care of --keyword options further up.
+           ;; (keyword (single-char #\k) (value #t))
+
+           (flag (value #t))
+           (force-po (value #f))
+           (indent (single-char #\i) (value #f))
+           (no-location (value #f))
+           (add-location (single-char #\n) (value #t))
+           (width (single-char #\w) (value #t))
+           (no-wrap (value #f))
+           (sort-output (single-char #\s) (value #f))
+           (sort-by-file (single-char #\F) (value #f))
+           (omit-header (value #f))
+           (copyright-holder (value #t))
+           (foreign-user (value #f))
+           (package-name (value #t))
+           (package-version (value #t))
+           (msgid-bugs-address (value #t))
+           (msgstr-prefix (single-char #\m) (value #t))
+           (msgstr-suffix (single-char #\m) (value #t))
+           (help (value #f))
+           (pack (value #f)))))
+    (getopt-long (command-line) option-spec)))
+
+
+(define parse-scheme-file
+  ;; This procedure parses FILE and returns a parse tree.
+  (let ()
+    ;;TODO: Optionally ignore case.
+    (define-peg-pattern NL all "\n")
+    (define-peg-pattern comment all (and ";"
+                                         (* (and peg-any
+                                                 (not-followed-by NL)))
+                                         (and peg-any (followed-by NL))))
+    (define-peg-pattern empty none (or " " "\t"))
+    (define-peg-pattern whitespace body (or empty NL))
+    (define-peg-pattern quotation body (or "'" "`" "," ",@"))
+                                        ;TODO: Allow user to specify
+                                        ;other quote reader macros to
+                                        ;be ignored and also ignore
+                                        ;quote spelled out without
+                                        ;reader macro.
+    (define-peg-pattern open body (and (? quotation)
+                                       (or "(" "[" "{")))
+    (define-peg-pattern close body (or ")" "]" "}"))
+    (define-peg-pattern string body (and (followed-by "\"")
+                                         (* (or "\\\""
+                                                (and (or NL peg-any)
+                                                     (not-followed-by "\""))))
+                                         (and (or NL peg-any)
+                                              (followed-by "\""))
+                                         "\""))
+    (define-peg-pattern token all (or string
+                                      (and
+                                       (not-followed-by open)
+                                       (not-followed-by close)
+                                       (not-followed-by comment)
+                                       (* (and peg-any
+                                               (not-followed-by open)
+                                               (not-followed-by close)
+                                               (not-followed-by comment)
+                                               (not-followed-by string)
+                                               (not-followed-by whitespace)))
+                                       (or
+                                        (and peg-any (followed-by open))
+                                        (and peg-any (followed-by close))
+                                        (and peg-any (followed-by comment))
+                                        (and peg-any (followed-by string))
+                                        (and peg-any (followed-by whitespace))
+                                        (not-followed-by peg-any)))))
+    (define-peg-pattern list all (or (and (? quotation) "(" program ")")
+                                     (and (? quotation) "[" program "]")
+                                     (and (? quotation) "{" program "}")))
+    (define-peg-pattern t-or-s body (or token list))
+    (define-peg-pattern program all (* (or whitespace
+                                           comment
+                                           t-or-s)))
+    (lambda (file)
+      (call-with-input-file file
+        (lambda (port)
+          ;; It would be nice to match port directly without
+          ;; converting to a string first, but apparently guile cannot
+          ;; do that yet.
+          (let ((string (get-string-all port)))
+            (peg:tree (match-pattern program string))))))))
+
+
+(define-record-type <po-entry>
+  (make-po-entry ecomments ref flags ctxt id idpl)
+  po-entry?
+;;; irrelevant: (tcomments po-entry-tcomments) ;translator-comments
+  (ecomments po-entry-ecomments) ;extracted-comments
+  (ref po-entry-ref) ;reference
+  (flags po-entry-flags)
+;;; irrelevant: (prevctxt po-entry-prevctxt) ;previous-ctxt
+;;; irrelevant: (prev po-entry-prev) ;previous-translation
+  (ctxt po-entry-ctxt) ;msgctxt
+  (id po-entry-id) ;msgid
+  (idpl po-entry-idpl) ;msgid-plural
+;;; irrelevant: (str po-entry-str) ;msgstr string or association list
+;;;                                ;integer to string
+  )
+
+(define (po-equal? po1 po2)
+  "Returns whether PO1 and PO2 have equal ctxt, id and idpl."
+  (and (equal? (po-entry-ctxt po1) (po-entry-ctxt po2))
+       (equal? (po-entry-id po1) (po-entry-id po2))
+       (equal? (po-entry-idpl po1) (po-entry-idpl po2))))
+
+(define (combine-duplicate-po-entries list)
+  "Returns LIST with duplicate po entries replaced by a single PO
+entry with both refs."
+  (let loop ((remaining list))
+    (match remaining
+      (() '())
+      ((head . tail)
+       (receive (before from)
+           (break (cut po-equal? head <>) tail)
+         (cond
+          ((null? from) (cons head (loop tail)))
+          (else
+           (loop
+            (cons
+             (match head
+               (($ <po-entry> ecomments1 ref1 flags ctxt id idpl)
+                (match (car from)
+                  (($ <po-entry> ecomments2 ref2 _ _ _ _)
+                   (let ((ecomments (if (or ecomments1 ecomments2)
+                                        (append (or ecomments1 '())
+                                                (or ecomments2 '()))
+                                        #f))
+                         (ref (if (or ref1 ref2)
+                                  (string-join
+                                   (cons
+                                    (or ref1 "")
+                                    (cons
+                                     (or ref2 "")
+                                     '())))
+                                  #f)))
+                     (make-po-entry ecomments ref flags ctxt id idpl))))))
+             (append before (cdr from)))))))))))
+
+(define (write-po-entry po-entry)
+  (define (prepare-text text)
+    "If TEXT is false, returns #f.  Otherwise corrects the formatting
+of TEXT by escaping backslashes and newlines and enclosing TEXT in
+quotes. Note that Scheme’s write is insufficient because it would
+escape far more.  TODO: Strings should be wrappable to a maximum line
+width."
+    (and text
+         (string-append "\""
+                        (with-output-to-string
+                          (lambda ()
+                            (call-with-input-string text
+                              (lambda (port)
+                                (let loop ((c (get-char port)))
+                                  (unless (eof-object? c)
+                                    (case c
+                                      ((#\\) (display "\\"))
+                                      ((#\newline) (display "\\n"))
+                                      (else (write-char c)))
+                                    (loop (get-char port))))))))
+                        "\"")))
+  (define (write-component c prefix)
+    (when c
+      (begin (display prefix)
+             (display " ")
+             (display c)
+             (newline))))
+  (match po-entry
+    (($ <po-entry> ecomments ref flags ctxt id idpl)
+     (let ((prepared-ctxt (prepare-text ctxt))
+           (prepared-id (prepare-text id))
+           (prepared-idpl (prepare-text idpl)))
+       (when ecomments
+         (for-each
+          (lambda (line)
+            (write-component line "#."))
+          (reverse ecomments)))
+       (write-component ref "#:")
+       (write-component (and flags (string-join flags ", ")) "#,")
+       (write-component prepared-ctxt "msgctxt")
+       (write-component prepared-id "msgid")
+       (write-component prepared-idpl "msgid_plural")
+       (display "msgstr \"\"")
+       (newline)))))
+
+(define %comments-line
+  (make-parameter #f))
+
+(define %ecomments-string
+  (make-parameter #f))
+
+(define (update-ecomments-string! str)
+  "Sets the value of the parameter object %ecomments-string if str is
+an ecomments string.  An ecomments string is extracted from a comment
+because it starts with TRANSLATORS or a key specified with
+--add-comments." ;TODO: Support for other keys is missing.
+  (cond
+   ((not str) (%ecomments-string #f))
+   ((= (1+ (or (%comments-line) -42)) (or (%line-number) 0))
+    (let ((m (string-match ";+[ \t]*(.*)" str)))
+      (when m
+        (%comments-line (%line-number))
+        (%ecomments-string
+         (if (%ecomments-string)
+             (cons (match:substring m 1) (%ecomments-string))
+             (list (match:substring m 1)))))))
+   (else
+    (let ((m (string-match ";+[ \t]*(TRANSLATORS:.*)" str)))
+      (if m
+          (begin
+            (%comments-line (%line-number))
+            (%ecomments-string
+             (if (%ecomments-string)
+                 (cons (match:substring m 1) (%ecomments-string))
+                 (list (match:substring m 1)))))
+          (%ecomments-string '#f))))))
+
+(define %file-name
+  (make-parameter #f))
+
+(define (update-file-name! name)
+  "Sets the value of the parameter object %file-name to NAME."
+  (%file-name name))
+
+(define %old-line-number
+  (make-parameter #f))
+
+(define (update-old-line-number! number)
+  "Sets the value of the parameter object %old-line-number to NUMBER."
+  (%old-line-number number))
+
+(define %line-number
+  (make-parameter #f))
+
+(define (update-line-number! number)
+  "Sets the value of the parameter object %line-number to NUMBER."
+  (%line-number number))
+
+(define (incr-line-number!)
+  "Increments the value of the parameter object %line-number by 1."
+  (%line-number (1+ (%line-number))))
+
+(define (incr-line-number-for-each-nl! list)
+  "Increments %line-number once for each NL recursively in LIST.  Does
+nothing if LIST is no list but e.g. an empty 'program."
+  (when (list? list)
+    (for-each
+     (lambda (part)
+       (match part
+         ('NL (incr-line-number!))
+         ((? list?) (incr-line-number-for-each-nl! part))
+         (else #f)))
+     list)))
+
+(define (current-ref)
+  "Returns the location field for a PO entry."
+  (let ((add (option-ref %options 'add-location 'full)))
+    (cond
+     ((option-ref %options 'no-location #f) #f)
+     ((eq? add 'full)
+      (string-append (%file-name) ":" (number->string (%line-number))))
+     ((eq? add 'file)
+      (%file-name))
+     ((eq? add 'never)
+      #f))))
+
+(define (make-simple-po-entry msgid)
+  (let ((po (make-po-entry
+             (%ecomments-string)
+             (current-ref)
+             #f ;TODO: Use scheme-format for format strings?
+             #f ;no ctxt
+             msgid
+             #f)))
+    (update-ecomments-string! #f)
+    po))
+
+
+(define (matching-keyword id)
+  "Returns the keyword-spec whose identifier is the same as ID, or #f
+if ID is no string or no such keyword-spec exists."
+  (and (symbol? id)
+       (let ((found (member (symbol->string id)
+                            %keyword-specs
+                            (lambda (id spec)
+                              (string=? id (keyword-spec-id spec))))))
+         (and found (car found)))))
+
+(define (nth-exp program n)
+  "Returns the Nth 'token or 'list inside the PROGRAM parse tree or #f
+if no tokens or lists exist."
+  (let loop ((i 0)
+             (rest program))
+    (define (on-hit exp)
+      (if (= i n) exp
+          ;; else:
+          (loop (1+ i) (cdr rest))))
+    (match rest
+      (() #f)
+      ((('token . _) . _) (on-hit (car rest)))
+      ((('list open-paren exp close-paren) . _) (on-hit (car rest)))
+      ((_ . _) (loop i (cdr rest)))
+      (else #f))))
+
+(define (more-than-one-exp? program)
+  "Returns true if PROGRAM consiste of more than one expression."
+  (if (matching-keyword (token->string-symbol-or-keyw (nth-exp program 0)))
+      (nth-exp program 2) ;if there is third element, keyword does not count
+      (nth-exp program 1)))
+
+(define (token->string-symbol-or-keyw tok)
+  "For a parse tree TOK, if it is a 'token parse tree, returns its
+value as a string, symbol or #:-keyword, otherwise returns #f."
+  (match tok
+    (('token (parts ...) . remaining)
+     ;; This is a string with line breaks in it.
+     (with-input-from-string
+         (string-append
+          (apply string-append
+                 (map-in-order
+                  (lambda (part)
+                    (match part
+                      (('NL _)
+                       (begin (incr-line-number!)
+                              "\n"))
+                      (else part)))
+                  parts))
+          (car remaining))
+       (lambda ()
+         (read))))
+    (('token exp)
+     (with-input-from-string exp
+       (lambda ()
+         (read))))
+    (else #f)))
+
+(define (complex-marked-list->po-entries parse-tree)
+  "Checks if PARSE-TREE is marked by a keyword.  If yes, for a complex
+keyword spec, returns a list of po-entries for it.  For a simple
+keyword spec, returns the argument number of its singular form.
+Otherwise returns #f."
+  (let* ((first (nth-exp parse-tree 0))
+         (spec (matching-keyword (token->string-symbol-or-keyw first))))
+    (if spec
+        (if ;if the identifier of a complex keyword occurs first
+         (complex-keyword-spec? spec)
+         ;; then make po entries for it
+         (match spec
+           (($ <keyword-spec> id sg pl c total xcomment)
+            (if (eq? c 'mixed) ; if msgctxt and singular msgid are in one string
+                (let* ((exp (nth-exp parse-tree sg))
+                       (val (token->string-symbol-or-keyw exp))
+                       (idx (if (string? val) (string-rindex val #\|))))
+                  (list
+                   (let ((po (make-po-entry
+                              (%ecomments-string)
+                              (current-ref)
+                              #f ;TODO: Use scheme-format for format strings?
+                              (string-take val idx)
+                              (string-drop val (1+ idx))
+                              #f))) ;plural forms are unsupported here
+                     (update-ecomments-string! #f)
+                     po)))
+                ;; else construct msgids
+                (receive (pl-id pl-entries)
+                    (match pl
+                      (#t (construct-msgid-and-po-entries
+                           (nth-exp parse-tree pl)))
+                      (#f (values #f '())))
+                  (receive (sg-id sg-entries)
+                      (construct-msgid-and-po-entries
+                       (nth-exp parse-tree sg))
+                    (cons
+                     (let ((po (make-po-entry
+                                (%ecomments-string)
+                                (current-ref)
+                                #f ;TODO: Use scheme-format for format strings?
+                                (and c (token->string-symbol-or-keyw
+                                        (nth-exp parse-tree c)))
+                                sg-id
+                                pl-id)))
+                       (update-ecomments-string! #f)
+                       po)
+                     (append sg-entries pl-entries)))))))
+         ;; else if it is a simple keyword, return the argnum:
+         (keyword-spec-sg spec))
+        ;; if no keyword occurs, then false
+        #f)))
+
+(define (construct-po-entries parse-tree)
+  "Converts a PARSE-TREE resulting from a call to parse-scheme-file to
+a list of po-entry records.  Unlike construct-msgid-and-po-entries,
+strings are not collected to a msgid.  The list of po-entry records is
+the return value."
+  (let ((entries (complex-marked-list->po-entries parse-tree)))
+    (cond
+     ((list? entries) entries)
+     ((number? entries) ;parse-tree yields a single, simple po entry
+      (update-old-line-number! (%line-number))
+      (receive (id entries)
+          (construct-msgid-and-po-entries
+           (nth-exp parse-tree entries))
+        (update-line-number! (%old-line-number))
+        (let ((po (make-simple-po-entry id)))
+          (incr-line-number-for-each-nl! parse-tree)
+          (cons po entries))))
+     (else ;search for marked translations in parse-tree
+      (match parse-tree
+        (() '())
+        (('comment str) (begin
+                          (update-ecomments-string! str)
+                          '()))
+        (('NL _) (begin (incr-line-number!) '()))
+        (('token . _) (begin (incr-line-number-for-each-nl! parse-tree) '()))
+        (('list open-paren program close-paren)
+         (construct-po-entries program))
+        (('program . components)
+         (append-map construct-po-entries components))
+        ;; Note: PEG compresses empty programs to non-lists:
+        ('program
+         '()))))))
+
+(define* (tag counter prefix #:key (flavor 'start))
+  "Formats the number COUNTER as a tag according to FLAVOR, which is
+either 'start, 'end or 'empty for a start, end or empty tag,
+respectively."
+  (string-append "<"
+                 (if (eq? flavor 'end) "/" "")
+                 prefix
+                 (number->string counter)
+                 (if (eq? flavor 'empty) "/" "")
+                 ">"))
+
+(define-record-type <construct-fold-state>
+  (make-construct-fold-state msgid-string maybe-part counter po-entries)
+  construct-fold-state?
+  ;; msgid constructed so far:
+  (msgid-string construct-fold-state-msgid-string)
+  ;; only append this if string follows:
+  (maybe-part construct-fold-state-maybe-part)
+  ;; counter for next tag:
+  (counter construct-fold-state-counter)
+  ;; complete po entries from marked sub-expressions:
+  (po-entries construct-fold-state-po-entries))
+
+(define* (construct-msgid-and-po-entries parse-tree
+                                         #:optional
+                                         (prefix ""))
+  "Like construct-po-entries, but with two return values.  The first
+is an accumulated msgid constructed from all components in PARSE-TREE
+for use in make-po-entry.  Non-strings are replaced by tags containing
+PREFIX.  The second return value is a list of po entries for
+sub-expressions marked with a complex keyword spec."
+  (match parse-tree
+    (() (values "" '()))
+    ;; Note: PEG compresses empty programs to non-lists:
+    ('program (values "" '()))
+    (('comment str) (begin
+                      (update-ecomments-string! str)
+                      (values "" '())))
+    (('NL _) (begin (incr-line-number!)
+                    (error "Program consists only of line break."
+                           `(,(%file-name) ,(%line-number)))))
+    (('token . _)
+     (let ((maybe-string (token->string-symbol-or-keyw parse-tree)))
+       (if (string? maybe-string)
+           (values maybe-string '())
+           (error "Single symbol marked for translation."
+                  `(,maybe-string ,(%file-name) ,(%line-number))))))
+    (('list open-paren program close-paren)
+     ;; parse program instead
+     (construct-msgid-and-po-entries program prefix))
+    (('program (? matching-keyword))
+     (error "Double-marked for translation."
+            `(,parse-tree ,(%file-name) ,(%line-number))))
+    (('program . components)
+     ;; Concatenate strings in parse-tree to a new msgid and add an
+     ;; <x> tag for each list in between.
+     (match
+         (fold
+          (lambda (component prev-state)
+            (match prev-state
+              (($ <construct-fold-state> msgid-string maybe-part
+                  counter po-entries)
+               (match component
+                 (('comment str) (begin (update-ecomments-string! str)
+                                        prev-state))
+                 (('NL _) (begin (incr-line-number!)
+                                 prev-state))
+                 (('token . _)
+                  (let ((maybe-string (token->string-symbol-or-keyw component)))
+                    (cond
+                     ((string? maybe-string)
+                      ;; if string, append maybe-string to previous msgid
+                      (make-construct-fold-state
+                       (string-append msgid-string maybe-part maybe-string)
+                       ""
+                       counter
+                       po-entries))
+                     ((and (more-than-one-exp? components) ;not the only symbol
+                           (or (string-null? msgid-string) ;no string so far
+                               (string-suffix? ">" msgid-string))) ;tag before
+                      prev-state) ;then ignore
+                     (else ;append tag representing the token
+                      (make-construct-fold-state
+                       msgid-string
+                       (string-append
+                        maybe-part
+                        (tag counter prefix #:flavor 'empty))
+                       (1+ counter)
+                       po-entries)))))
+                 (('list open-paren program close-paren)
+                  (let ((first (nth-exp program 0)))
+                    (incr-line-number-for-each-nl! list)
+                    (match (complex-marked-list->po-entries program)
+                      ((? list? result)
+                       (make-construct-fold-state
+                        msgid-string
+                        (string-append
+                         maybe-part
+                         (tag counter prefix #:flavor 'empty))
+                        (1+ counter)
+                        (append result po-entries)))
+                      (result
+                       (cond
+                        ((number? result)
+                         (receive (id entries)
+                             (construct-msgid-and-po-entries
+                              program
+                              (string-append prefix
+                                             (number->string counter)
+                                             "."))
+                           (make-construct-fold-state
+                            (string-append msgid-string
+                                           maybe-part
+                                           (tag counter prefix
+                                                #:flavor 'start)
+                                           id
+                                           (tag counter prefix
+                                                #:flavor 'end))
+                            ""
+                            (1+ counter)
+                            (append entries po-entries))))
+                        ((not (more-than-one-exp? components))
+                         ;; Singletons do not need to be marked.
+                         (receive (id entries)
+                             (construct-msgid-and-po-entries
+                              program
+                              prefix)
+                           (make-construct-fold-state
+                            id
+                            ""
+                            counter
+                            (append entries po-entries))))
+                        (else ;unmarked list
+                         (if (string-null? msgid-string)
+                             ;; then ignore
+                             prev-state
+                             ;; else:
+                             (make-construct-fold-state
+                              msgid-string
+                              (string-append
+                               maybe-part
+                               (tag counter prefix #:flavor 'empty))
+                              (1+ counter)
+                              po-entries))))))))))))
+          (make-construct-fold-state "" "" 1 '())
+          components)
+       (($ <construct-fold-state> msgid-string maybe-part counter po-entries)
+        (values msgid-string po-entries))))))
+
+(define scheme-file->po-entries
+  (compose construct-po-entries
+           parse-scheme-file))
+
+(define %files-from-port
+  (let ((files-from (option-ref %options 'files #f)))
+    (if files-from
+        (open-input-file files-from)
+        (current-input-port))))
+
+(define %source-files
+  (let loop ((line (get-line %files-from-port))
+             (source-files '()))
+    (if (eof-object? line)
+        (begin
+          (close-port %files-from-port)
+          source-files)
+        ;; else read file names before comment
+        (let ((before-comment (car (string-split line #\#))))
+          (loop (get-line %files-from-port)
+                (append
+                 (map match:substring (list-matches "[^ \t]+" line))
+                 source-files))))))
+
+(define %output-po-entries
+  (fold (lambda (scheme-file po-entries)
+          (begin
+            (update-file-name! scheme-file)
+            (update-line-number! 1)
+            (update-old-line-number! #f)
+            (%comments-line #f)
+            (append (scheme-file->po-entries scheme-file)
+                    po-entries)))
+        '()
+        %source-files))
+
+(define %output-port
+  (let ((output (option-ref %options 'output #f))
+        (domain (option-ref %options 'default-domain #f)))
+    (cond
+     (output (open-output-file output))
+     (domain (open-output-file (string-append domain ".po")))
+     (else (open-output-file "messages.po")))))
+
+(with-output-to-port %output-port
+  (lambda ()
+    (let ((copyright (option-ref %options 'copyright-holder
+                                 "THE PACKAGE'S COPYRIGHT HOLDER"))
+          (package (option-ref %options 'package-name "PACKAGE"))
+          (version (option-ref %options 'package-version #f))
+          (bugs-email (option-ref %options 'msgid-bugs-address "")))
+      (display "# SOME DESCRIPTIVE TITLE.\n")
+      (display (string-append "# Copyright (C) YEAR " copyright "\n"))
+      (display (string-append "# This file is distributed under the same \
+license as the " package " package.\n"))
+      (display "# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.\n")
+      (display "#\n")
+      (write-po-entry (make-po-entry #f #f '("fuzzy") #f "" #f))
+      (display (string-append "\"Project-Id-Version: "
+                              package
+                              (if version
+                                  (string-append " " version)
+                                  "")
+                              "\\n\"\n"))
+      (display (string-append "\"Report-Msgid-Bugs-To: "
+                              bugs-email
+                              "\\n\"\n"))
+      (display (string-append "\"POT-Creation-Date: "
+                              (date->string (current-date) "~1 ~H:~M~z")
+                              "\\n\"\n"))
+      (display "\"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n\"\n")
+      (display "\"Last-Translator: FULL NAME <EMAIL@ADDRESS>\\n\"\n")
+      (display "\"Language-Team: LANGUAGE <LL@li.org>\\n\"\n")
+      (display "\"Language: \\n\"\n")
+      (display "\"MIME-Version: 1.0\\n\"\n")
+      (display "\"Content-Type: text/plain; charset=UTF-8\\n\"\n")
+      (display "\"Content-Transfer-Encoding: 8bit\\n\"\n")
+      (for-each (lambda (po-entry)
+                  (begin
+                    (newline)
+                    (write-po-entry po-entry)))
+                (combine-duplicate-po-entries %output-po-entries)))))
diff --git a/website/sexp-xgettext.scm b/website/sexp-xgettext.scm
new file mode 100644
index 0000000..45ee3df
--- /dev/null
+++ b/website/sexp-xgettext.scm
@@ -0,0 +1,454 @@
+;;; GNU Guix web site
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
+;;;
+;;; This file is part of the GNU Guix web site.
+;;;
+;;; The GNU Guix web site is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; The GNU Guix web site 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 Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with the GNU Guix web site.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (sexp-xgettext)
+  #:use-module (ice-9 local-eval)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1) ;lists
+  #:use-module (srfi srfi-9) ;records
+  #:export (set-complex-keywords!
+            set-simple-keywords!
+            sgettext
+            sngettext
+            spgettext
+            snpgettext))
+
+(define %complex-keywords
+  ;; Use set-complex-keywords! to change this to a list of keywords
+  ;; for sexp-xgettext functions other than sgettext.
+  (make-parameter '()))
+
+(define (set-complex-keywords! kw)
+  (%complex-keywords kw))
+
+(define %simple-keywords
+  ;; Use set-simple-keywords! to change this to a list of keywords
+  ;; for sgettext.
+  (make-parameter '()))
+
+(define (set-simple-keywords! kw)
+  (%simple-keywords kw))
+
+(define (gettext-keyword? id)
+  (or (member id (%complex-keywords))
+      (member id (%simple-keywords))))
+
+;;COPIED FROM scripts/sexp-xgettext.scm:
+(define* (tag counter prefix #:key (flavor 'start))
+  "Formats the number COUNTER as a tag according to FLAVOR, which is
+either 'start, 'end or 'empty for a start, end or empty tag,
+respectively."
+  (string-append "<"
+                 (if (eq? flavor 'end) "/" "")
+                 prefix
+                 (number->string counter)
+                 (if (eq? flavor 'empty) "/" "")
+                 ">"))
+;;END COPIED FROM scripts/sexp-xgettext.scm
+
+;;SEMI-COPIED FROM scripts/sexp-xgettext.scm
+(define-record-type <construct-fold-state>
+  (make-construct-fold-state msgid-string maybe-part counter)
+  construct-fold-state?
+  ;; msgid constructed so far
+  (msgid-string construct-fold-state-msgid-string)
+  ;; only append this if string follows:
+  (maybe-part construct-fold-state-maybe-part)
+  ;; counter for next tag:
+  (counter construct-fold-state-counter))
+;;END SEMI-COPIED FROM scripts/sexp-xgettext.scm
+
+(define (sexp->msgid exp)
+  "Return the msgid as constructed by construct-msgid-and-po-entries
+in scripts/sexp-xgettext.scm from the expression EXP."
+  (let loop ((exp exp)
+             (prefix ""))
+    (match exp
+      (() "")
+      ((or ('quote inner-exp)
+           ('quasiquote inner-exp)
+           ('unquote inner-exp)
+           ('unquote-splicing inner-exp))
+       (loop inner-exp prefix))
+      ((first-component . components)
+       (cond
+        ((gettext-keyword? first-component)
+         (error "Double-marked for translation." exp))
+        (else
+         (construct-fold-state-msgid-string
+          (fold
+           (lambda (component prev-state)
+             (match prev-state
+               (($ <construct-fold-state> msgid-string maybe-part counter)
+                (let inner-loop ((exp component))
+                  (match exp
+                    ((or (? symbol?) (? keyword?))
+                     (if (string-null? msgid-string)
+                         ;; ignore symbols at the beginning
+                         prev-state
+                         ;; else make a tag for the symbol
+                         (make-construct-fold-state
+                          msgid-string
+                          (string-append maybe-part
+                                         (tag counter prefix #:flavor 'empty))
+                          (1+ counter))))
+                    ((? string?)
+                     (make-construct-fold-state
+                      (string-append msgid-string maybe-part exp) "" counter))
+                    ((? list?)
+                     (match exp
+                       (() ;ignore empty list
+                        prev-state)
+                       ((or (singleton)
+                            ('quote singleton)
+                            ('quasiquote singleton)
+                            ('unquote singleton)
+                            ('unquote-splicing singleton))
+                        (inner-loop singleton))
+                       ((components ...)
+                        (cond
+                         ((and (not (null? components))
+                               (member (car components) (%simple-keywords)))
+                          ;; if marked for translation, insert inside tag
+                          (make-construct-fold-state
+                           (string-append msgid-string
+                                          maybe-part
+                                          (tag counter prefix #:flavor 'start)
+                                          (loop (cadr components)
+                                                (string-append
+                                                 prefix
+                                                 (number->string counter)
+                                                 "."))
+                                          (tag counter prefix #:flavor 'end))
+                           ""
+                           (1+ counter)))
+                         ;; else ignore if first
+                         ((string-null? msgid-string)
+                          prev-state)
+                         ;; else make empty tag
+                         (else (make-construct-fold-state
+                                msgid-string
+                                (string-append
+                                 maybe-part
+                                 (tag counter prefix #:flavor 'empty))
+                                (1+ counter))))))))))))
+           (make-construct-fold-state "" "" 1)
+           exp)))))
+      ((? string?) exp)
+      (else (error "Single symbol marked for translation." exp)))))
+
+(define-record-type <deconstruct-fold-state>
+  (make-deconstruct-fold-state tagged maybe-tagged counter)
+  deconstruct-fold-state?
+  ;; XML-tagged expressions as an association list name->expression:
+  (tagged deconstruct-fold-state-tagged)
+  ;; associate this not-yet-tagged expression with pre if string
+  ;; follows, with post if not:
+  (maybe-tagged deconstruct-fold-state-maybe-tagged)
+  ;; counter for next tag:
+  (counter deconstruct-fold-state-counter))
+
+(define (deconstruct exp msgstr)
+  "Return an s-expression like EXP, but filled with the content from
+MSGSTR."
+  (define (find-empty-element msgstr name)
+    "Returns the regex match structure for the empty tag for XML
+element of type NAME inside MSGSTR.  If the element does not exist or
+is more than the empty tag, #f is returned."
+    (string-match (string-append "<" (regexp-quote name) "/>") msgstr))
+  (define (find-element-with-content msgstr name)
+    "Returns the regex match structure for the non-empty XML element
+of type NAME inside MSGSTR.  Submatch 1 is its content.  If the
+element does not exist or is just the empty tag, #f is returned."
+    (string-match (string-append "<" (regexp-quote name) ">"
+                                 "(.*)"
+                                 "</" (regexp-quote name) ">")
+                  msgstr))
+  (define (get-first-element-name prefix msgstr)
+    "Returns the name of the first XML element in MSGSTR whose name
+begins with PREFIX, or #f if there is none."
+    (let ((m (string-match
+              (string-append "<(" (regexp-quote prefix) "[^>/.]+)/?>") msgstr)))
+      (and m (match:substring m 1))))
+  (define (prefix+counter prefix counter)
+    "Returns PREFIX with the number COUNTER appended."
+    (string-append prefix (number->string counter)))
+  (let loop ((exp exp)
+             (msgstr msgstr)
+             (prefix ""))
+    (define (unwrap-marked-expression exp)
+      "Returns two values for an expression EXP containing a (possibly
+quoted/unquoted) marking for translation with a simple keyword at its
+root.  The first return value is a list with the inner expression, the
+second is a procedure to wrap the processed inner expression in the
+same quotes or unquotes again."
+      (match exp
+        (('quote inner-exp)
+         (receive (unwrapped quotation)
+             (unwrap-marked-expression inner-exp)
+           (values unwrapped
+                   (lambda (res)
+                     (list 'quote (quotation res))))))
+        (('quasiquote inner-exp)
+         (receive (unwrapped quotation)
+             (unwrap-marked-expression inner-exp)
+           (values unwrapped
+                   (lambda (res)
+                     (list 'quasiquote (quotation res))))))
+        (('unquote inner-exp)
+         (receive (unwrapped quotation)
+             (unwrap-marked-expression inner-exp)
+           (values unwrapped
+                   (lambda (res)
+                     (list 'unquote (quotation res))))))
+        (('unquote-splicing inner-exp)
+         (receive (unwrapped quotation)
+             (unwrap-marked-expression inner-exp)
+           (values unwrapped
+                   (lambda (res)
+                     (list 'unquote-splicing (quotation res))))))
+        ((marking . rest) ;list with marking as car
+         ;; assume arg to translate is first argument to marking:
+         (values (list-ref rest 0) identity))))
+    (define (assemble-parenthesized-expression prefix tagged)
+      "Returns a parenthesized expression deconstructed from MSGSTR
+with the meaning of XML elements taken from the name->expression
+association list TAGGED.  The special tags [prefix]pre and
+[prefix]post are associated with a list of expressions before or after
+all others in the parenthesized expression with the prefix,
+respectively, in reverse order."
+      (append ;prepend pre elements to what is in msgstr
+       (reverse (or (assoc-ref tagged (string-append prefix "pre")) '()))
+       (let assemble ((rest msgstr))
+         (let ((name (get-first-element-name prefix rest)))
+           (cond
+            ((and name (find-empty-element rest name)) =>
+             ;; first XML element in rest is empty element
+             (lambda (m)
+               (cons*
+                (match:prefix m) ;prepend string before name
+                (assoc-ref tagged name) ;and expression for name
+                (assemble (match:suffix m)))))
+            ((and name (find-element-with-content rest name)) =>
+             ;; first XML element in rest has content
+             (lambda (m)
+               (receive (unwrapped quotation)
+                   (unwrap-marked-expression (assoc-ref tagged name))
+                 (cons*
+                  (match:prefix m) ;prepend string before name
+                  ;; and the deconstructed element with the content as msgstr:
+                  (quotation
+                   (loop
+                    unwrapped
+                    (match:substring m 1)
+                    (string-append name ".")))
+                  (assemble (match:suffix m))))))
+            (else
+             ;; there is no first element
+             (cons
+              rest ;return remaining string
+              (reverse ;and post expressions
+               (or (assoc-ref tagged (string-append prefix "post")) '())))))))))
+    (match exp
+      (() '())
+      (('quote singleton)
+       (cons 'quote (list (loop singleton msgstr prefix))))
+      (('quasiquote singleton)
+       (cons 'quasiquote (list (loop singleton msgstr prefix))))
+      (('unquote singleton)
+       (cons 'unquote (list (loop singleton msgstr prefix))))
+      (('unquote-splicing singleton)
+       (cons 'unquote-splicing (list (loop singleton msgstr prefix))))
+      ((singleton)
+       (list (loop singleton msgstr prefix)))
+      ((first-component . components)
+       (cond
+        ((gettext-keyword? first-component)
+         ;; another marking for translation
+         ;; -> should be an error anyway; just retain exp
+         exp)
+        (else
+         ;; This handles a single level of a parenthesized expression.
+         ;; assemble-parenthesized-expression will call loop to
+         ;; recurse to deeper levels.
+         (let ((tagged-state
+                (fold
+                 (lambda (component prev-state)
+                   (match prev-state
+                     (($ <deconstruct-fold-state> tagged maybe-tagged counter)
+                      (let inner-loop ((exp component) ;sexp to handle
+                                       (quoting identity)) ;for wrapping state
+                        (define (tagged-with-maybes)
+                          "Returns the value of tagged after adding
+all maybe-tagged expressions.  This should be used as the base value
+for tagged when a string or marked expression is seen."
+                          (match counter
+                            (#f
+                             (alist-cons (string-append prefix "pre")
+                                         maybe-tagged
+                                         tagged))
+                            ((? number?)
+                             (let accumulate ((prev-counter counter)
+                                              (maybes (reverse maybe-tagged)))
+                               (match maybes
+                                 (() tagged)
+                                 ((head . tail)
+                                  (alist-cons
+                                   (prefix+counter prefix prev-counter)
+                                   head
+                                   (accumulate (1+ prev-counter) tail))))))))
+                        (define (add-maybe exp)
+                          "Returns a deconstruct-fold-state with EXP
+added to maybe-tagged.  This should be used for expressions that are
+neither strings nor marked for translation with a simple keyword."
+                          (make-deconstruct-fold-state
+                           tagged
+                           (cons (quoting exp) maybe-tagged)
+                           counter))
+                        (define (counter-with-maybes)
+                          "Returns the old counter value incremented
+by one for each expression in maybe-tagged.  This should be used
+together with tagged-with-maybes."
+                          (match counter
+                            ((? number?)
+                             (+ counter (length maybe-tagged)))
+                            (#f
+                             1)))
+                        (define (add-tagged exp)
+                          "Returns a deconstruct-fold-state with an
+added association in tagged from the current counter to EXP.  If
+MAYBE-TAGGED is not empty, associations for its expressions are added
+to pre or their respective counter.  This should be used for
+expressions marked for translation with a simple keyword."
+                          (let ((c (counter-with-maybes)))
+                            (make-deconstruct-fold-state
+                             (alist-cons
+                              (prefix+counter prefix c)
+                              (quoting exp)
+                              (tagged-with-maybes))
+                             '()
+                             (1+ c))))
+                        (match exp
+                          (('quote inner-exp)
+                           (inner-loop inner-exp
+                                       (lambda (res)
+                                         (list 'quote res))))
+                          (('quasiquote inner-exp)
+                           (inner-loop inner-exp
+                                       (lambda (res)
+                                         (list 'quasiquote res))))
+                          (('unquote inner-exp)
+                           (inner-loop inner-exp
+                                       (lambda (res)
+                                         (list 'unquote res))))
+                          (('unquote-splicing inner-exp)
+                           (inner-loop inner-exp
+                                       (lambda (res)
+                                         (list 'unquote-splicing res))))
+                          (((? gettext-keyword?) . rest)
+                           (add-tagged exp))
+                          ((or (? symbol?) (? keyword?) (? list?))
+                           (add-maybe exp))
+                          ((? string?)
+                           ;; elements in maybe-tagged appear between strings
+                           (let ((c (counter-with-maybes)))
+                             (make-deconstruct-fold-state
+                              (tagged-with-maybes)
+                              '()
+                              c))))))))
+                 (make-deconstruct-fold-state '() '() #f)
+                 exp)))
+           (match tagged-state
+             (($ <deconstruct-fold-state> tagged maybe-tagged counter)
+              (assemble-parenthesized-expression
+               prefix
+               (match maybe-tagged
+                 (() tagged)
+                 (else ;associate maybe-tagged with pre or post
+                  (alist-cons
+                   (cond ;if there already is a pre, use post
+                    ((assoc-ref tagged (string-append prefix "pre"))
+                     (string-append prefix "post"))
+                    (else (string-append prefix "pre")))
+                   maybe-tagged
+                   tagged))))))))))
+      ((? string?) msgstr)
+      (else (error "Single symbol marked for translation." exp)))))
+
+(define (sgettext x)
+  "After choosing an identifier for marking s-expressions for
+translation, make it usable by defining a macro with it calling
+sgettext.  If for example the chosen identifier is G_,
+use (define-syntax G_ sgettext)."
+  (syntax-case x ()
+    ((_ exp)
+     (let* ((msgstr (sexp->msgid (syntax->datum #'exp)))
+            (new-exp (deconstruct (syntax->datum #'exp)
+                                  (gettext msgstr))))
+       (datum->syntax #'exp new-exp)))))
+
+(define (sngettext x)
+  "After choosing an identifier for behavior similar to ngettext:1,2,
+make it usable like (define-syntax N_ sngettext)."
+  (syntax-case x ()
+    ((_ msgid1 msgid2 n)
+     (let* ((msgstr1 (sexp->msgid (syntax->datum #'msgid1)))
+            (msgstr2 (sexp->msgid (syntax->datum #'msgid2)))
+            (applicable (if (= #'n 1) #'msgid1 #'msgid2))
+            (new-exp (deconstruct (syntax->datum applicable)
+                                  (ngettext msgstr1 msgstr2 #'n))))
+       (datum->syntax #'msgid1 new-exp)))))
+
+;; gettext’s share/gettext/gettext.h tells us we can prepend a msgctxt
+;; and #\eot before a msgid in a gettext call.
+
+(define (spgettext x)
+  "After choosing an identifier for behavior similar to pgettext:1c,2,
+make it usable like (define-syntax C_ spgettext)."
+  (syntax-case x ()
+    ((_ msgctxt exp)
+     (let* ((gettext-context-glue #\eot) ;as defined in gettext.h
+            (lookup (string-append (syntax->datum #'msgctxt)
+                                   (string gettext-context-glue)
+                                   (sexp->msgid (syntax->datum #'exp))))
+            (msgstr (car (reverse (string-split (gettext lookup)
+                                                gettext-context-glue))))
+            (new-exp (deconstruct (syntax->datum #'exp)
+                                  msgstr)))
+       (datum->syntax #'exp new-exp)))))
+
+(define (snpgettext x)
+  "After choosing an identifier for behavior similar to npgettext:1c,2,3,
+make it usable like (define-syntax NC_ snpgettext)."
+  (syntax-case x ()
+    ((_ msgctxt msgid1 msgid2 n)
+     (let* ((gettext-context-glue #\eot) ;as defined in gettext.h
+            (lookup1 (string-append (syntax->datum #'msgctxt)
+                                    (string gettext-context-glue)
+                                    (sexp->msgid (syntax->datum #'msgid1))))
+            ;; gettext.h implementation shows: msgctxt is only part of msgid1.
+            (lookup2 (sexp->msgid (syntax->datum #'msgid2)))
+            (msgstr (car (reverse
+                          (string-split (gettext (ngettext lookup1 lookup2 #'n))
+                                        gettext-context-glue))))
+            (applicable (if (= #'n 1) #'msgid1 #'msgid2))
+            (new-exp (deconstruct (syntax->datum applicable)
+                                  msgstr)))
+       (datum->syntax #'msgid1 new-exp)))))
-- 
2.22.0


[-- Attachment #4: 0003-website-Use-custom-xgettext-implementation.patch --]
[-- Type: text/plain, Size: 6884 bytes --]

From b59785ef4e51156b69c0c1a8e6e0724dcadddb44 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Wed, 7 Aug 2019 23:52:31 +0200
Subject: [PATCH 3/6] website: Use custom xgettext implementation.

* website/po/POTFILES: New file; list apps/base/templates files here.
* website/po/LINGUAS: New file.  List en_US lingua.
* website/apps/i18n.scm: New file.  Add utility functions.
* website/haunt.scm: Load linguas and call each builder with each.
---
 website/apps/i18n.scm | 105 ++++++++++++++++++++++++++++++++++++++++++
 website/haunt.scm     |  24 +++++++---
 website/po/LINGUAS    |   1 +
 website/po/POTFILES   |  13 ++++++
 4 files changed, 137 insertions(+), 6 deletions(-)
 create mode 100644 website/apps/i18n.scm
 create mode 100644 website/po/LINGUAS
 create mode 100644 website/po/POTFILES

diff --git a/website/apps/i18n.scm b/website/apps/i18n.scm
new file mode 100644
index 0000000..fbbbd9f
--- /dev/null
+++ b/website/apps/i18n.scm
@@ -0,0 +1,105 @@
+;;; GNU Guix web site
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
+;;;
+;;; This file is part of the GNU Guix web site.
+;;;
+;;; The GNU Guix web site is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; The GNU Guix web site 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 Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with the GNU Guix web site.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (apps i18n)
+  #:use-module (haunt page)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 match)
+  #:use-module (sexp-xgettext)
+  #:use-module (srfi srfi-1)
+  #:export (G_
+            N_
+            C_
+            NC_
+            %current-lingua
+            builder->localized-builder
+            builders->localized-builders))
+
+(define %gettext-domain
+  "guix-website")
+
+(bindtextdomain %gettext-domain (getcwd))
+(bind-textdomain-codeset %gettext-domain "UTF-8")
+(textdomain %gettext-domain)
+
+(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 <page>
+  (@@ (haunt page) <page>))
+
+(define %current-lingua
+  (make-parameter "en_US"))
+
+(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 lingua)
+  "Returns a Haunt builder procedure generated from an existing
+BUILDER with translations for LINGUA coming from sexp-xgettext."
+  (compose
+   (lambda (pages)
+     (map
+      (lambda (page)
+        (match page
+          (($ <page> file-name contents writer)
+           (if (string-suffix? ".html" file-name)
+               (let* ((base (string-drop-right
+                             file-name
+                             (string-length ".html")))
+                      (new-name (string-append base
+                                               "."
+                                               lingua
+                                               ".html")))
+                 (make-page new-name contents writer))
+               page))
+          (else page)))
+      pages))
+   (lambda (site posts)
+     (begin
+       (setlocale LC_ALL (string-append lingua ".utf8"))
+       (parameterize ((%current-lingua lingua))
+         (first-value (builder site posts)))))))
+
+(define (builders->localized-builders builders linguas)
+  "Returns a list of new Haunt builder procedures generated from
+BUILDERS and localized via sexp-xgettext for each of the LINGUAS."
+  (flatten
+   (map-in-order
+    (lambda (builder)
+      (map-in-order
+       (lambda (lingua)
+         (builder->localized-builder builder lingua))
+       linguas))
+    builders)))
diff --git a/website/haunt.scm b/website/haunt.scm
index d29c0d4..eb0eafe 100644
--- a/website/haunt.scm
+++ b/website/haunt.scm
@@ -5,13 +5,23 @@
 (use-modules ((apps base builder) #:prefix base:)
 	     ((apps blog builder) #:prefix blog:)
 	     ((apps download builder) #:prefix download:)
+             (apps i18n)
 	     ((apps packages builder) #:prefix packages:)
 	     (haunt asset)
              (haunt builder assets)
              (haunt reader)
 	     (haunt reader commonmark)
-             (haunt site))
+             (haunt site)
+             (ice-9 rdelim)
+             (srfi srfi-1))
 
+(define linguas
+  (with-input-from-file "po/LINGUAS"
+    (lambda _
+      (let loop ((line (read-line)))
+        (if (eof-object? line)
+            '()
+            (cons line (loop (read-line))))))))
 
 (site #:title "GNU Guix"
       #:domain (if (getenv "GUIX_WEB_SITE_INFO")
@@ -19,8 +29,10 @@
                    "https://gnu.org/software/guix")
       #:build-directory "/tmp/gnu.org/software/guix"
       #:readers (list sxml-reader html-reader commonmark-reader)
-      #:builders (list base:builder
-		       blog:builder
-		       download:builder
-		       packages:builder
-		       (static-directory "static")))
+      #:builders (builders->localized-builders
+                  (list base:builder
+                        blog:builder
+                        download:builder
+                        packages:builder
+                        (static-directory "static"))
+                  linguas))
diff --git a/website/po/LINGUAS b/website/po/LINGUAS
new file mode 100644
index 0000000..7741b83
--- /dev/null
+++ b/website/po/LINGUAS
@@ -0,0 +1 @@
+en_US
diff --git a/website/po/POTFILES b/website/po/POTFILES
new file mode 100644
index 0000000..4013d52
--- /dev/null
+++ b/website/po/POTFILES
@@ -0,0 +1,13 @@
+apps/base/templates/about.scm
+apps/base/templates/components.scm
+apps/base/templates/contact.scm
+apps/base/templates/contribute.scm
+apps/base/templates/donate.scm
+apps/base/templates/graphics.scm
+apps/base/templates/help.scm
+apps/base/templates/home.scm
+apps/base/templates/irc.scm
+apps/base/templates/menu.scm
+apps/base/templates/screenshot.scm
+apps/base/templates/security.scm
+apps/base/templates/theme.scm
-- 
2.22.0


[-- Attachment #5: 0004-website-Mark-some-files-in-apps-base-for-translation.patch --]
[-- Type: text/plain, Size: 31952 bytes --]

From 43fc90e205054333a751b5fb1a73c29c922a367c Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Thu, 8 Aug 2019 00:01:50 +0200
Subject: [PATCH 4/6] website: Mark some files in apps/base for translation.

* website/apps/base/templates/about.scm (home-t): Mark for translation.
* website/apps/base/templates/components.scm (home-t): Mark for translation.
* website/apps/base/templates/contact.scm (home-t): Mark for translation.
* website/apps/base/templates/home.scm (home-t): Mark for translation.
* website/apps/base/templates/theme.scm (home-t): Mark for translation.
---
 website/apps/base/templates/about.scm      | 159 +++++++-------
 website/apps/base/templates/components.scm |  54 ++---
 website/apps/base/templates/contact.scm    |  20 +-
 website/apps/base/templates/home.scm       | 239 +++++++++++----------
 website/apps/base/templates/theme.scm      |  46 ++--
 5 files changed, 275 insertions(+), 243 deletions(-)

diff --git a/website/apps/base/templates/about.scm b/website/apps/base/templates/about.scm
index a654e2f..ecdc81b 100644
--- a/website/apps/base/templates/about.scm
+++ b/website/apps/base/templates/about.scm
@@ -6,102 +6,111 @@
   #:use-module (apps base templates theme)
   #:use-module (apps base types)
   #:use-module (apps base utils)
+  #:use-module (apps i18n)
   #:export (about-t))
 
 
 (define (about-t)
   "Return the About page in SHTML."
   (theme
-   #:title '("About")
+   #:title (G_ '("About"))
    #:description
-   "Guix is an advanced distribution of the GNU operating system.
-    Guix is technology that respects the freedom of computer users.
-    You are free to run the system for any purpose, study how it
-    works, improve it, and share it with the whole world."
+   (G_ "Guix is an advanced distribution of the GNU operating system.
+   Guix is technology that respects the freedom of computer users.
+   You are free to run the system for any purpose, study how it
+   works, improve it, and share it with the whole world.")
    #:keywords
-   (list "GNU" "Linux" "Unix" "Free software" "Libre software"
-	 "Operating system" "GNU Hurd" "GNU Guix package manager")
-   #:active-menu-item "About"
+   (string-split ;TRANSLATORS: |-separated list of webpage keywords
+    (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
+system|GNU Hurd|GNU Guix package manager") #\|)
+   #:active-menu-item (C_ "Website menu" "About")
    #:css (list
 	  (guix-url "static/base/css/page.css"))
-   #:crumbs (list (crumb "About" "./"))
+   #:crumbs (list (crumb (C_ "Website menu" "About") "./"))
    #:content
    `(main
      (section
       (@ (class "page centered-block limit-width"))
-      (h2 "About the Project")
+      ,(G_ `(h2 "About the Project"))
 
-      (p
-       "The " (em "GNU Guix") " package and system manager is a "
-       (a (@ (href ,(gnu-url "philosophy/free-sw.html")))
-	  "free software")
-       " project developed by volunteers around the world under the
-       umbrella of the " (a (@ (href ,(gnu-url))) "GNU Project") ". ")
+      ,(G_
+        `(p
+          "The " ,(G_ `(em "GNU Guix")) " package and system manager is a "
+          ,(G_ `(a (@ (href ,(gnu-url "philosophy/free-sw.html")))
+                   "free software"))
+          " project developed by volunteers around the world under the
+            umbrella of the "
+          ,(G_ `(a (@ (href ,(gnu-url))) "GNU Project")) ". "))
 
-      (p
-       "Guix System is an advanced distribution of the "
-       (a (@ (href ,(gnu-url))) "GNU operating system")
-       ".  It uses the "
-       (a (@ (href ,(gnu-url "software/linux-libre"))) "Linux-libre")
-       " kernel, and support for "
-       (a (@ (href ,(gnu-url "software/hurd"))) "the Hurd")
-       " is being worked on.  As a GNU distribution, it is committed
-       to respecting and enhancing "
-       (a (@ (href ,(gnu-url "philosophy/free-sw.html")))
-	  "the freedom of its users")
-       ".  As such, it adheres to the "
-       (a (@ (href ,(gnu-url "distros/free-system-distribution-guidelines.html")))
-	  "GNU Free System Distribution Guidelines") ".")
+      ,(G_
+        `(p
+          "Guix System is an advanced distribution of the "
+          ,(G_ `(a (@ (href ,(gnu-url))) "GNU operating system"))
+          ".  It uses the "
+          ,(G_ `(a (@ (href ,(gnu-url "software/linux-libre"))) "Linux-libre"))
+          " kernel, and support for "
+          ,(G_ `(a (@ (href ,(gnu-url "software/hurd"))) "the Hurd"))
+          " is being worked on.  As a GNU distribution, it is committed
+            to respecting and enhancing "
+          ,(G_ `(a (@ (href ,(gnu-url "philosophy/free-sw.html")))
+                   "the freedom of its users"))
+          ".  As such, it adheres to the "
+          ,(G_ `(a (@ (href ,(gnu-url "distros/free-system-distribution-guidelines.html")))
+                   "GNU Free System Distribution Guidelines")) "."))
 
-      (p
-       "GNU Guix provides "
-       (a (@ (href ,(manual-url "Features.html")))
-	  "state-of-the-art package management features")
-       " such as transactional upgrades and roll-backs, reproducible
-       build environments, unprivileged package management, and
-       per-user profiles.  It uses low-level mechanisms from the "
-       (a (@ (href "https://nixos.org/nix/")) "Nix")
-       " package manager, but packages are "
-       (a (@ (href ,(manual-url "Defining-Packages.html"))) "defined")
-       " as native "
-       (a (@ (href ,(gnu-url "software/guile"))) "Guile")
-       " modules, using extensions to the "
-       (a (@ (href "http://schemers.org")) "Scheme")
-       " language—which makes it nicely hackable.")
+      ,(G_
+        `(p
+          "GNU Guix provides "
+          ,(G_ `(a (@ (href ,(manual-url "Features.html")))
+                   "state-of-the-art package management features"))
+          " such as transactional upgrades and roll-backs, reproducible
+            build environments, unprivileged package management, and
+            per-user profiles.  It uses low-level mechanisms from the "
+          ,(G_ `(a (@ (href "https://nixos.org/nix/")) "Nix"))
+          " package manager, but packages are "
+          ,(G_ `(a (@ (href ,(manual-url "Defining-Packages.html"))) "defined"))
+          " as native "
+          ,(G_ `(a (@ (href ,(gnu-url "software/guile"))) "Guile"))
+          " modules, using extensions to the "
+          ,(G_ `(a (@ (href "http://schemers.org")) "Scheme"))
+          " language—which makes it nicely hackable."))
 
-      (p
-       "Guix takes that a step further by additionally supporting stateless,
-       reproducible "
-       (a (@ (href ,(manual-url "Using-the-Configuration-System.html")))
-	  "operating system configurations")
-       ". This time the whole system is hackable in Scheme, from the "
-       (a (@ (href ,(manual-url "Initial-RAM-Disk.html")))
-	  "initial RAM disk")
-       " to the "
-       (a (@ (href ,(gnu-url "software/shepherd")))
-	  "initialization system")
-       ", and to the "
-       (a (@ (href ,(manual-url "Defining-Services.html")))
-	  "system services")
-       ".")
+      ,(G_
+        `(p
+          "Guix takes that a step further by additionally supporting stateless,
+           reproducible "
+          ,(G_ `(a (@ (href ,(manual-url "Using-the-Configuration-System.html")))
+                   "operating system configurations"))
+          ". This time the whole system is hackable in Scheme, from the "
+          ,(G_ `(a (@ (href ,(manual-url "Initial-RAM-Disk.html")))
+                   "initial RAM disk"))
+          " to the "
+          ,(G_ `(a (@ (href ,(gnu-url "software/shepherd")))
+                   "initialization system"))
+          ", and to the "
+          ,(G_ `(a (@ (href ,(manual-url "Defining-Services.html")))
+                   "system services"))
+          "."))
 
 
-      (h3 (@ (id "mantainer")) "Maintainer")
+      ,(G_ `(h3 (@ (id "mantainer")) "Maintainer"))
 
-      (p
-       "Guix is currently maintained by Ludovic Courtès and Ricardo
-       Wurmus.  Please use the "
-       (a (@ (href ,(guix-url "contact/"))) "mailing lists")
-       " for contact. ")
+      ,(G_
+        `(p
+          "Guix is currently maintained by Ludovic Courtès and Ricardo
+          Wurmus.  Please use the "
+          ,(G_ `(a (@ (href ,(guix-url "contact/"))) "mailing lists"))
+          " for contact. "))
 
 
-      (h3 (@ (id "license")) "Licensing")
+      ,(G_ `(h3 (@ (id "license")) "Licensing"))
 
-      (p
-       "Guix is free software; you can redistribute it and/or modify
-       it under the terms of the "
-       (a (@ (rel "license") (href ,(gnu-url "licenses/gpl.html")))
-	  "GNU General Public License")
-       " as published by the Free Software Foundation; either
-       version\xa03 of the License, or (at your option) any later
-       version. ")))))
+      ,(G_
+        `(p
+          "Guix is free software; you can redistribute it and/or modify
+          it under the terms of the "
+          ,(G_ `(a (@ (rel "license") (href ,(gnu-url "licenses/gpl.html")))
+                   "GNU General Public License"))
+          " as published by the Free Software Foundation; either
+          version\xa03 of the License, or (at your option) any later
+          version. "))))))
diff --git a/website/apps/base/templates/components.scm b/website/apps/base/templates/components.scm
index d3f6af1..666abec 100644
--- a/website/apps/base/templates/components.scm
+++ b/website/apps/base/templates/components.scm
@@ -12,6 +12,7 @@
   #:use-module (apps aux web)
   #:use-module (apps base types)
   #:use-module (apps base utils)
+  #:use-module (apps i18n)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (breadcrumbs
@@ -41,9 +42,9 @@
      (apps base types)."
   `(nav
     (@ (class "breadcrumbs"))
-    (h2 (@ (class "a11y-offset")) "Your location:")
+    ,(G_ `(h2 (@ (class "a11y-offset")) "Your location:"))
 
-    (a (@ (class "crumb") (href ,(guix-url))) "Home") (span " → ")
+    ,(G_ `(a (@ (class "crumb") (href ,(guix-url))) "Home")) (span " → ")
     ,@(separate (crumbs->shtml crumbs) '(span " → "))))
 
 
@@ -121,8 +122,9 @@
        (sxml->string*
         (match (contact-description contact)
           ((and multilingual (((? string?) (? string?)) ...))
-           (match (assoc "en" multilingual)
-             (("en" blurb) blurb)))
+           (let ((code (car (string-split (%current-lingua) #\_))))
+             (match (assoc code multilingual)
+               ((code blurb) blurb))))
           (blurb
            blurb)))
        30)
@@ -145,7 +147,7 @@
     ,(if (string=? (contact-log contact) "")
 	 ""
 	 `(small
-	   " (" (a (@ (href ,(contact-log contact))) "archive") ") "))
+	   " (" ,(G_ `(a (@ (href ,(contact-log contact))) "archive")) ") "))
 
     ;; The description can be a list of language/blurb pairs.
     ,(match (contact-description contact)
@@ -284,26 +286,26 @@
     (h1
      (a
       (@ (class "branding") (href ,(guix-url)))
-      (span (@ (class "a11y-offset")) "Guix")))
+      ,(C_ "Website menu" `(span (@ (class "a11y-offset")) "Guix"))))
 
     ;; Menu.
     (nav (@ (class "menu"))
-     (h2 (@ (class "a11y-offset")) "Website menu:")
+         ,(G_ `(h2 (@ (class "a11y-offset")) "Website menu:"))
      (ul
-      ,(menu-item #:label "Overview" #:active-item active-item #:url (guix-url))
-      ,(menu-item #:label "Download" #:active-item active-item #:url (guix-url "download/"))
-      ,(menu-item #:label "Packages" #:active-item active-item #:url (guix-url "packages/"))
-      ,(menu-item #:label "Blog" #:active-item active-item #:url (guix-url "blog/"))
-      ,(menu-item #:label "Help" #:active-item active-item #:url (guix-url "help/"))
-      ,(menu-item #:label "Donate" #:active-item active-item #:url (guix-url "donate/"))
-
-      ,(menu-dropdown #:label "About" #:active-item active-item #:url (guix-url "about/")
+      ,(C_ "Website menu" (menu-item #:label "Overview" #:active-item active-item #:url (guix-url)))
+      ,(C_ "Website menu" (menu-item #:label "Download" #:active-item active-item #:url (guix-url "download/")))
+      ,(C_ "Website menu" (menu-item #:label "Packages" #:active-item active-item #:url (guix-url "packages/")))
+      ,(C_ "Website menu" (menu-item #:label "Blog" #:active-item active-item #:url (guix-url "blog/")))
+      ,(C_ "Website menu" (menu-item #:label "Help" #:active-item active-item #:url (guix-url "help/")))
+      ,(C_ "Website menu" (menu-item #:label "Donate" #:active-item active-item #:url (guix-url "donate/")))
+
+      ,(menu-dropdown #:label (C_ "Website menu" "About") #:active-item active-item #:url (guix-url "about/")
 	#:items
-	(list
-	 (menu-item #:label "Contact" #:active-item active-item #:url (guix-url "contact/"))
-	 (menu-item #:label "Contribute" #:active-item active-item #:url (guix-url "contribute/"))
-	 (menu-item #:label "Security" #:active-item active-item #:url (guix-url "security/"))
-	 (menu-item #:label "Graphics" #:active-item active-item #:url (guix-url "graphics/"))))))
+        (list
+         (C_ "Website menu" (menu-item #:label "Contact" #:active-item active-item #:url (guix-url "contact/")))
+         (C_ "Website menu" (menu-item #:label "Contribute" #:active-item active-item #:url (guix-url "contribute/")))
+         (C_ "Website menu" (menu-item #:label "Security" #:active-item active-item #:url (guix-url "security/")))
+         (C_ "Website menu" (menu-item #:label "Graphics" #:active-item active-item #:url (guix-url "graphics/")))))))
 
     ;; Menu button.
     (a
@@ -321,10 +323,10 @@
    TOTAL-PAGES (number)
      The total number of pages that should be displayed."
   (if (> total-pages 1)
-      `(span
-	(@ (class "page-number-indicator"))
-	" (Page " ,(number->string page-number)
-	" of " ,(number->string total-pages) ")")
+      (G_ `(span
+            (@ (class "page-number-indicator"))
+            " (Page " ,(number->string page-number)
+            " of " ,(number->string total-pages) ")"))
       ""))
 
 
@@ -345,8 +347,8 @@
     (@ (class "page-selector"))
     (h3
      (@ (class "a11y-offset"))
-     ,(string-append "Page " (number->string active-page) " of "
-		     (number->string pages) ". Go to another page: "))
+     ,(G_ (string-append "Page " (number->string active-page) " of "
+                         (number->string pages) ". Go to another page: ")))
     ,(if (> pages 1)
 	 (map
 	  (lambda (page-number)
diff --git a/website/apps/base/templates/contact.scm b/website/apps/base/templates/contact.scm
index d4ee2f2..5b8df63 100644
--- a/website/apps/base/templates/contact.scm
+++ b/website/apps/base/templates/contact.scm
@@ -7,31 +7,33 @@
   #:use-module (apps base templates theme)
   #:use-module (apps base types)
   #:use-module (apps base utils)
+  #:use-module (apps i18n)
   #:export (contact-t))
 
 
 (define (contact-t context)
   "Return the Contact page in SHTML with the data in CONTEXT."
   (theme
-   #:title '("Contact")
+   #:title (G_ '("Contact"))
    #:description
-   "A list of channels to communicate with GNU Guix users
-   and developers about anything you want."
+   (G_ "A list of channels to communicate with GNU Guix users
+   and developers about anything you want.")
    #:keywords
-   '("GNU" "Linux" "Unix" "Free software" "Libre software"
-     "Operating system" "GNU Hurd" "GNU Guix package manager"
-     "Community" "Mailing lists" "IRC channels" "Bug reports" "Help")
-   #:active-menu-item "About"
+   (string-split ;TRANSLATORS: |-separated list of webpage keywords
+    (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
+system|GNU Hurd|GNU Guix package manager|Community|Mailing lists|IRC
+channels|Bug reports|Help") #\|)
+   #:active-menu-item (C_ "Website menu" "About")
    #:css (list
 	  (guix-url "static/base/css/page.css")
           (guix-url "static/base/css/buttons.css")
 	  (guix-url "static/base/css/contact.css"))
-   #:crumbs (list (crumb "Contact" "./"))
+   #:crumbs (list (crumb (C_ "Website menu" "Contact") "./"))
    #:content
    `(main
      (section
       (@ (class "page centered-block limit-width"))
-      (h2 "Contact")
+      ,(G_ `(h2 "Contact"))
 
       ,@(map
 	 contact->shtml
diff --git a/website/apps/base/templates/home.scm b/website/apps/base/templates/home.scm
index 5cb3bf5..827724f 100644
--- a/website/apps/base/templates/home.scm
+++ b/website/apps/base/templates/home.scm
@@ -8,24 +8,26 @@
   #:use-module (apps base types)
   #:use-module (apps base utils)
   #:use-module (apps blog templates components)
+  #:use-module (apps i18n)
   #:export (home-t))
 
 
 (define (home-t context)
   "Return the Home page in SHTML using the data in CONTEXT."
   (theme
-   #:title '("GNU's advanced distro and transactional package manager")
+   #:title (G_ '("GNU's advanced distro and transactional package manager"))
    #:description
-   "Guix is an advanced distribution of the GNU operating system.
+   (G_ "Guix is an advanced distribution of the GNU operating system.
    Guix is technology that respects the freedom of computer users.
-   You are free to run the system for any purpose, study how it works,
-   improve it, and share it with the whole world."
+   You are free to run the system for any purpose, study how it
+   works, improve it, and share it with the whole world.")
    #:keywords
-   '("GNU" "Linux" "Unix" "Free software" "Libre software"
-     "Operating system" "GNU Hurd" "GNU Guix package manager"
-     "GNU Guile" "Guile Scheme" "Transactional upgrades"
-     "Functional package management" "Reproducibility")
-   #:active-menu-item "Overview"
+   (string-split ;TRANSLATORS: |-separated list of webpage keywords
+    (G_ "GNU|Linux|Unix|Free software|Libre software|Operating \
+system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile \
+Scheme|Transactional upgrades|Functional package \
+management|Reproducibility") #\|)
+   #:active-menu-item (C_ "Website menu" "Overview")
    #:css (list
 	  (guix-url "static/base/css/item-preview.css")
 	  (guix-url "static/base/css/index.css"))
@@ -34,83 +36,89 @@
      ;; Featured content.
      (section
       (@ (class "featured-content"))
-      (h2 (@ (class "a11y-offset")) "Summary")
+      ,(G_ `(h2 (@ (class "a11y-offset")) "Summary"))
       (ul
-       (li
-	(b "Liberating.")
-	" Guix is an advanced
-        distribution of the "
-	,(link-yellow
-	  #:label "GNU operating system"
-	  #:url (gnu-url "gnu/about-gnu.html"))
-	" developed by the "
-	,(link-yellow
-	  #:label "GNU Project"
-	  #:url (gnu-url))
-	"—which respects the "
-	,(link-yellow
-	  #:label "freedom of computer users"
-	  #:url (gnu-url "distros/free-system-distribution-guidelines.html"))
-	". ")
-
-       (li
-	(b "Dependable.")
-        " Guix "
-	,(link-yellow
-	  #:label "supports"
-	  #:url (manual-url "Package-Management.html"))
-        " transactional upgrades and roll-backs, unprivileged
-        package management, "
-	,(link-yellow
-	  #:label "and more"
-	  #:url (manual-url "Features.html"))
-	".  When used as a standalone distribution, Guix supports "
-        ,(link-yellow
-          #:label "declarative system configuration"
-          #:url (manual-url "Using-the-Configuration-System.html"))
-        " for transparent and reproducible operating systems.")
-
-       (li
-	(b "Hackable.")
-	" It provides "
-	,(link-yellow
-	  #:label "Guile Scheme"
-	  #:url (gnu-url "software/guile/"))
-	" APIs, including high-level embedded domain-specific
-        languages (EDSLs) to "
-	,(link-yellow
-	  #:label "define packages"
-	  #:url (manual-url "Defining-Packages.html"))
-	" and "
-	,(link-yellow
-	  #:label "whole-system configurations"
-	  #:url (manual-url "System-Configuration.html"))
-	"."))
+       ,(G_
+         `(li
+           ,(G_ `(b "Liberating."))
+           " Guix is an advanced distribution of the "
+           ,(G_ (link-yellow
+                 #:label "GNU operating system"
+                 #:url (gnu-url "gnu/about-gnu.html")))
+           " developed by the "
+           ,(G_ (link-yellow
+                 #:label "GNU Project"
+                 #:url (gnu-url)))
+           "—which respects the "
+           ,(G_ (link-yellow
+                 #:label "freedom of computer users"
+                 #:url (gnu-url "distros/free-system-distribution-\
+guidelines.html")))
+           ". "))
+
+       ,(G_
+         `(li
+           ,(G_ `(b "Dependable."))
+           " Guix "
+           ,(G_ (link-yellow
+                 #:label "supports"
+                 #:url (manual-url "Package-Management.html")))
+           " transactional upgrades and roll-backs, unprivileged \
+package management, "
+           ,(G_ (link-yellow
+                 #:label "and more"
+                 #:url (manual-url "Features.html")))
+           ".  When used as a standalone distribution, Guix supports "
+           ,(G_ (link-yellow
+                 #:label "declarative system configuration"
+                 #:url (manual-url "Using-the-Configuration-System.html")))
+           " for transparent and reproducible operating systems."))
+
+       ,(G_
+         `(li
+           ,(G_ `(b "Hackable."))
+           " It provides "
+           ,(G_ (link-yellow
+                 #:label "Guile Scheme"
+                 #:url (gnu-url "software/guile/")))
+           " APIs, including high-level embedded domain-specific \
+languages (EDSLs) to "
+           ,(G_ (link-yellow
+                 #:label "define packages"
+                 #:url (manual-url "Defining-Packages.html")))
+         " and "
+         ,(G_ (link-yellow
+               #:label "whole-system configurations"
+               #:url (manual-url "System-Configuration.html")))
+         ".")))
 
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label (string-append "DOWNLOAD v" (latest-guix-version))
+         #:label (apply string-append
+                        (C_ "button" `("DOWNLOAD v" ,(latest-guix-version) "")))
 	 #:url (guix-url "download/")
 	 #:light #true)
        " " ; A space for readability in non-CSS browsers.
        ,(button-big
-	 #:label "CONTRIBUTE"
+         #:label (C_ "button" "CONTRIBUTE")
 	 #:url (guix-url "contribute/")
 	 #:light #true)))
 
      ;; Discover Guix.
      (section
       (@ (class "discovery-box"))
-      (h2 "Discover Guix")
-
-      (p
-       (@ (class "limit-width centered-block"))
-       "Guix comes with thousands of packages which include
-       applications, system tools, documentation, fonts, and other
-       digital goods readily available for installing with the "
-       ,(link-yellow #:label "GNU Guix" #:url "#guix-in-other-distros")
-       " package manager.")
+      ,(G_ `(h2 "Discover Guix"))
+
+      ,(G_
+        `(p
+          (@ (class "limit-width centered-block"))
+          "Guix comes with thousands of packages which include \
+applications, system tools, documentation, fonts, and other digital \
+goods readily available for installing with the "
+          ,(G_ (link-yellow #:label "GNU Guix"
+                            #:url (identity "#guix-in-other-distros")))
+          " package manager."))
 
       (div
        (@ (class "screenshots-box"))
@@ -119,55 +127,57 @@
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label "ALL PACKAGES"
+         #:label (C_ "button" "ALL PACKAGES")
 	 #:url (guix-url "packages/")
 	 #:light #true))
 
       ,(horizontal-separator #:light #true)
 
       ;; Guix in different fields.
-      (h3 "GNU Guix in your field")
+      ,(G_ `(h3 "GNU Guix in your field"))
 
-      (p
-       (@ (class "limit-width centered-block"))
-       "Read some stories about how people are using GNU Guix in their daily
-       lives.")
+      ,(G_
+        `(p
+          (@ (class "limit-width centered-block"))
+          "Read some stories about how people are using GNU Guix in
+their daily lives."))
 
       (div
        (@ (class "fields-box"))
 
        " " ; A space for readability in non-CSS browsers (same below).
        ,(button-big
-	 #:label "SOFTWARE DEVELOPMENT"
-	 #:url (guix-url "blog/tags/software-development/")
-	 #:light #true)
+         #:label (C_ "button" "SOFTWARE DEVELOPMENT")
+         #:url (guix-url "blog/tags/software-development/")
+         #:light #true)
        " "
        ,(button-big
-	 #:label "BIOINFORMATICS"
-	 #:url (guix-url "blog/tags/bioinformatics/")
-	 #:light #true)
+         #:label (C_ "button" "BIOINFORMATICS")
+         #:url (guix-url "blog/tags/bioinformatics/")
+         #:light #true)
        " "
        ,(button-big
-	 #:label "HIGH PERFORMANCE COMPUTING"
-	 #:url (guix-url "blog/tags/high-performance-computing/")
-	 #:light #true)
+         #:label (C_ "button" "HIGH PERFORMANCE COMPUTING")
+         #:url (guix-url "blog/tags/high-performance-computing/")
+         #:light #true)
        " "
        ,(button-big
-	 #:label "RESEARCH"
-	 #:url (guix-url "blog/tags/research/")
-	 #:light #true)
+         #:label (C_ "button" "RESEARCH")
+         #:url (guix-url "blog/tags/research/")
+         #:light #true)
        " "
        ,(button-big
-	 #:label "ALL FIELDS..."
-	 #:url (guix-url "blog/")
-	 #:light #true))
+         #:label (C_ "button" "ALL FIELDS...")
+         #:url (guix-url "blog/")
+         #:light #true))
 
       ,(horizontal-separator #:light #true)
 
       ;; Using Guix in other distros.
-      (h3
-       (@ (id "guix-in-other-distros"))
-       "GNU Guix in other GNU/Linux distros")
+      ,(G_
+        `(h3
+          (@ (id "guix-in-other-distros"))
+          "GNU Guix in other GNU/Linux distros"))
 
       (div
        (@ (class "info-box"))
@@ -176,54 +186,55 @@
 	   (src "https://audio-video.gnu.org/video/misc/2016-07__GNU_Guix_Demo_2.webm")
 	   (poster ,(guix-url "static/media/img/guix-demo.png"))
 	   (controls "controls"))
-	(p
-	 "Video: "
-	 ,(link-yellow
-	   #:label "Demo of Guix in another GNU/Linux distribution"
-	   #:url "https://audio-video.gnu.org/video/misc/2016-07__GNU_Guix_Demo_2.webm")
-	 " (1 minute, 30 seconds).")))
+        ,(G_
+          `(p
+            "Video: "
+            ,(G_ (link-yellow
+                  #:label "Demo of Guix in another GNU/Linux distribution"
+                  #:url "https://audio-video.gnu.org/video/misc/\
+2016-07__GNU_Guix_Demo_2.webm"))
+            " (1 minute, 30 seconds)."))))
 
       (div
        (@ (class "info-box justify-left"))
-       (p
-	"If you don't use GNU Guix as a standalone GNU/Linux distribution,
-        you still can use it as a
-	package manager on top of any GNU/Linux distribution. This
-        way, you can benefit from all its conveniences.")
+       ,(G_ `(p
+              "If you don't use GNU Guix as a standalone GNU/Linux \
+distribution, you still can use it as a package manager on top of any \
+GNU/Linux distribution. This way, you can benefit from all its conveniences."))
 
-       (p
-	"Guix won't interfere with the package manager that comes
-        with your distribution. They can live together."))
+       ,(G_ `(p
+              "Guix won't interfere with the package manager that comes \
+with your distribution. They can live together.")))
 
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label "TRY IT OUT!"
+         #:label (C_ "button" "TRY IT OUT!")
 	 #:url (guix-url "download/")
 	 #:light #true)))
 
      ;; Latest Blog posts.
      (section
       (@ (class "centered-text"))
-      (h2 "Blog")
+      ,(G_ `(h2 "Blog"))
 
       ,@(map post-preview (context-datum context "posts"))
 
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label "ALL POSTS"
+         #:label (C_ "button" "ALL POSTS")
 	 #:url (guix-url "blog/"))))
 
      ;; Contact info.
      (section
       (@ (class "contact-box centered-text"))
-      (h2 "Contact")
+      ,(G_ `(h2 "Contact"))
 
       ,@(map contact-preview (context-datum context "contact-media"))
 
       (div
        (@ (class "action-box centered-text"))
        ,(button-big
-	 #:label "ALL CONTACT MEDIA"
+         #:label (C_ "button" "ALL CONTACT MEDIA")
 	 #:url (guix-url "contact/")))))))
diff --git a/website/apps/base/templates/theme.scm b/website/apps/base/templates/theme.scm
index ecb27ef..f300a8c 100644
--- a/website/apps/base/templates/theme.scm
+++ b/website/apps/base/templates/theme.scm
@@ -5,11 +5,12 @@
 (define-module (apps base templates theme)
   #:use-module (apps base templates components)
   #:use-module (apps base utils)
+  #:use-module (apps i18n)
   #:export (theme))
 
 
 (define* (theme #:key
-		(lang-tag "en")
+		(lang-tag (car (string-split (%current-lingua) #\_)))
 		(title '())
 		(description "")
 		(keywords '())
@@ -65,12 +66,14 @@
   `((doctype "html")
 
     (html
-     (@ (lang "en"))
+     (@ (lang ,(car (string-split (%current-lingua) #\_))))
 
      (head
       ,(if (null? title)
-	   `(title "GNU Guix")
-	   `(title ,(string-join (append title '("GNU Guix")) " — ")))
+	   `(title (C_ "webpage title" "GNU Guix"))
+	   `(title ,(string-join (append title
+                                         (C_ "webpage title" '("GNU Guix")))
+                                 " — ")))
       (meta (@ (charset "UTF-8")))
       (meta (@ (name "keywords") (content ,(string-join keywords ", "))))
       (meta (@ (name "description") (content ,description)))
@@ -91,7 +94,7 @@
 	     css)
       ;; Feeds.
       (link (@ (type "application/atom+xml") (rel "alternate")
-	       (title "GNU Guix — Activity Feed")
+	       (title (C_ "webpage title" "GNU Guix — Activity Feed"))
 	       (href ,(guix-url "feeds/blog.atom"))))
       (link (@ (rel "icon") (type "image/png")
 	       (href ,(guix-url "static/base/img/icon.png"))))
@@ -108,17 +111,22 @@
       ,(if (null? crumbs) "" (breadcrumbs crumbs))
 
       ,content
-      (footer
-       "Made with " (span (@ (class "metta")) "♥")
-       " by humans and powered by "
-       (a (@ (class "link-yellow") (href ,(gnu-url "software/guile/")))
-	  "GNU Guile") ".  "
-	  (a
-	   (@ (class "link-yellow")
-	      (href "//git.savannah.gnu.org/cgit/guix/guix-artwork.git/tree/website"))
-	   "Source code")
-	  " under the "
-	  (a
-	   (@ (class "link-yellow")
-	      (href ,(gnu-url "licenses/agpl-3.0.html")))
-	   "GNU AGPL") ".")))))
+      ,(G_
+        `(footer
+          "Made with " ,(G_ `(span (@ (class "metta")) "♥"))
+          " by humans and powered by "
+          ,(G_ `(a
+                 (@ (class "link-yellow")
+                    (href ,(gnu-url "software/guile/")))
+                 "GNU Guile"))
+          ".  "
+          ,(G_ `(a
+                 (@ (class "link-yellow")
+                    (href "//git.savannah.gnu.org/cgit/guix/guix-artwork.git/tree/website"))
+                 "Source code"))
+          " under the "
+          ,(G_ `(a
+                 (@ (class "link-yellow")
+                    (href ,(gnu-url "licenses/agpl-3.0.html")))
+                 "GNU AGPL"))
+          "."))))))
-- 
2.22.0


[-- Attachment #6: 0005-website-Generate-localizeable-POT-file.patch --]
[-- Type: text/plain, Size: 10837 bytes --]

From 13f7a039e6d04e5b2b74cb2cf23fd837dbcfaffa Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Thu, 8 Aug 2019 00:04:04 +0200
Subject: [PATCH 5/6] website: Generate localizeable POT file.

* website/po/guix-website.pot: Add it.
---
 website/po/guix-website.pot | 294 ++++++++++++++++++++++++++++++++++++
 1 file changed, 294 insertions(+)
 create mode 100644 website/po/guix-website.pot

diff --git a/website/po/guix-website.pot b/website/po/guix-website.pot
new file mode 100644
index 0000000..d2e0e74
--- /dev/null
+++ b/website/po/guix-website.pot
@@ -0,0 +1,294 @@
+# SOME DESCRIPTIVE TITLE.
+# Copyright (C) YEAR Ludovic Courtès
+# This file is distributed under the same license as the guix-website package.
+# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
+#
+#, fuzzy
+msgid ""
+msgstr ""
+"Project-Id-Version: guix-website\n"
+"Report-Msgid-Bugs-To: ludo@gnu.org\n"
+"POT-Creation-Date: 2019-08-07 23:03+0200\n"
+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
+"Language-Team: LANGUAGE <LL@li.org>\n"
+"Language: \n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+
+#: apps/base/templates/about.scm:16
+msgid "About"
+msgstr ""
+
+#: apps/base/templates/about.scm:18 apps/base/templates/home.scm:20
+msgid "Guix is an advanced distribution of the GNU operating system.\n   Guix is technology that respects the freedom of computer users.\n   You are free to run the system for any purpose, study how it\n   works, improve it, and share it with the whole world."
+msgstr ""
+
+#. TRANSLATORS: |-separated list of webpage keywords
+#: apps/base/templates/about.scm:24
+msgid "GNU|Linux|Unix|Free software|Libre software|Operating system|GNU Hurd|GNU Guix package manager"
+msgstr ""
+
+#: apps/base/templates/about.scm:26 apps/base/templates/about.scm:29 apps/base/templates/components.scm:302 apps/base/templates/contact.scm:26
+msgctxt "Website menu"
+msgid "About"
+msgstr ""
+
+#: apps/base/templates/about.scm:34
+msgid "About the Project"
+msgstr ""
+
+#: apps/base/templates/about.scm:36
+msgid "The <1>GNU Guix</1> package and system manager is a <2>free software</2> project developed by volunteers around the world under the\n            umbrella of the <3>GNU Project</3>. "
+msgstr ""
+
+#: apps/base/templates/about.scm:45
+msgid "Guix System is an advanced distribution of the <1>GNU operating system</1>.  It uses the <2>Linux-libre</2> kernel, and support for <3>the Hurd</3> is being worked on.  As a GNU distribution, it is committed\n            to respecting and enhancing <4>the freedom of its users</4>.  As such, it adheres to the <5>GNU Free System Distribution Guidelines</5>."
+msgstr ""
+
+#: apps/base/templates/about.scm:61
+msgid "GNU Guix provides <1>state-of-the-art package management features</1> such as transactional upgrades and roll-backs, reproducible\n            build environments, unprivileged package management, and\n            per-user profiles.  It uses low-level mechanisms from the <2>Nix</2> package manager, but packages are <3>defined</3> as native <4>Guile</4> modules, using extensions to the <5>Scheme</5> language—which makes it nicely hackable."
+msgstr ""
+
+#: apps/base/templates/about.scm:78
+msgid "Guix takes that a step further by additionally supporting stateless,\n           reproducible <1>operating system configurations</1>. This time the whole system is hackable in Scheme, from the <2>initial RAM disk</2> to the <3>initialization system</3>, and to the <4>system services</4>."
+msgstr ""
+
+#: apps/base/templates/about.scm:96
+msgid "Maintainer"
+msgstr ""
+
+#: apps/base/templates/about.scm:98
+msgid "Guix is currently maintained by Ludovic Courtès and Ricardo\n          Wurmus.  Please use the <1>mailing lists</1> for contact. "
+msgstr ""
+
+#: apps/base/templates/about.scm:106
+msgid "Licensing"
+msgstr ""
+
+#: apps/base/templates/about.scm:108
+msgid "Guix is free software; you can redistribute it and/or modify\n          it under the terms of the <1>GNU General Public License</1> as published by the Free Software Foundation; either\n          version 3 of the License, or (at your option) any later\n          version. "
+msgstr ""
+
+#: apps/base/templates/components.scm:45
+msgid "Your location:"
+msgstr ""
+
+#: apps/base/templates/components.scm:47
+msgid "Home"
+msgstr ""
+
+#: apps/base/templates/components.scm:150
+msgid "archive"
+msgstr ""
+
+#: apps/base/templates/components.scm:289
+msgctxt "Website menu"
+msgid "Guix"
+msgstr ""
+
+#: apps/base/templates/components.scm:293
+msgid "Website menu:"
+msgstr ""
+
+#: apps/base/templates/components.scm:295 apps/base/templates/home.scm:30
+msgctxt "Website menu"
+msgid "Overview"
+msgstr ""
+
+#: apps/base/templates/components.scm:296
+msgctxt "Website menu"
+msgid "Download"
+msgstr ""
+
+#: apps/base/templates/components.scm:297
+msgctxt "Website menu"
+msgid "Packages"
+msgstr ""
+
+#: apps/base/templates/components.scm:298
+msgctxt "Website menu"
+msgid "Blog"
+msgstr ""
+
+#: apps/base/templates/components.scm:299
+msgctxt "Website menu"
+msgid "Help"
+msgstr ""
+
+#: apps/base/templates/components.scm:300
+msgctxt "Website menu"
+msgid "Donate"
+msgstr ""
+
+#: apps/base/templates/components.scm:305 apps/base/templates/contact.scm:31
+msgctxt "Website menu"
+msgid "Contact"
+msgstr ""
+
+#: apps/base/templates/components.scm:306
+msgctxt "Website menu"
+msgid "Contribute"
+msgstr ""
+
+#: apps/base/templates/components.scm:307
+msgctxt "Website menu"
+msgid "Security"
+msgstr ""
+
+#: apps/base/templates/components.scm:308
+msgctxt "Website menu"
+msgid "Graphics"
+msgstr ""
+
+#: apps/base/templates/components.scm:326
+msgid " (Page <1/> of <2/>)"
+msgstr ""
+
+#: apps/base/templates/components.scm:350
+msgid "Page <1/> of <2/>. Go to another page: "
+msgstr ""
+
+#: apps/base/templates/contact.scm:17 apps/base/templates/contact.scm:36 apps/base/templates/home.scm:232
+msgid "Contact"
+msgstr ""
+
+#: apps/base/templates/contact.scm:19
+msgid "A list of channels to communicate with GNU Guix users\n   and developers about anything you want."
+msgstr ""
+
+#. TRANSLATORS: |-separated list of webpage keywords
+#: apps/base/templates/contact.scm:23
+msgid "GNU|Linux|Unix|Free software|Libre software|Operating system|GNU Hurd|GNU Guix package manager|Community|Mailing lists|IRC\nchannels|Bug reports|Help"
+msgstr ""
+
+#: apps/base/templates/home.scm:18
+msgid "GNU's advanced distro and transactional package manager"
+msgstr ""
+
+#. TRANSLATORS: |-separated list of webpage keywords
+#: apps/base/templates/home.scm:26
+msgid "GNU|Linux|Unix|Free software|Libre software|Operating system|GNU Hurd|GNU Guix package manager|GNU Guile|Guile Scheme|Transactional upgrades|Functional package management|Reproducibility"
+msgstr ""
+
+#: apps/base/templates/home.scm:39
+msgid "Summary"
+msgstr ""
+
+#: apps/base/templates/home.scm:41
+msgid "<1>Liberating.</1> Guix is an advanced distribution of the <2>GNU operating system</2> developed by the <3>GNU Project</3>—which respects the <4>freedom of computer users</4>. "
+msgstr ""
+
+#: apps/base/templates/home.scm:59
+msgid "<1>Dependable.</1> Guix <2>supports</2> transactional upgrades and roll-backs, unprivileged package management, <3>and more</3>.  When used as a standalone distribution, Guix supports <4>declarative system configuration</4> for transparent and reproducible operating systems."
+msgstr ""
+
+#: apps/base/templates/home.scm:77
+msgid "<1>Hackable.</1> It provides <2>Guile Scheme</2> APIs, including high-level embedded domain-specific languages (EDSLs) to <3>define packages</3> and <4>whole-system configurations</4>."
+msgstr ""
+
+#: apps/base/templates/home.scm:99
+msgctxt "button"
+msgid "DOWNLOAD v<1/>"
+msgstr ""
+
+#: apps/base/templates/home.scm:104
+msgctxt "button"
+msgid "CONTRIBUTE"
+msgstr ""
+
+#: apps/base/templates/home.scm:111
+msgid "Discover Guix"
+msgstr ""
+
+#: apps/base/templates/home.scm:113
+msgid "Guix comes with thousands of packages which include applications, system tools, documentation, fonts, and other digital goods readily available for installing with the <1>GNU Guix</1> package manager."
+msgstr ""
+
+#: apps/base/templates/home.scm:130
+msgctxt "button"
+msgid "ALL PACKAGES"
+msgstr ""
+
+#: apps/base/templates/home.scm:137
+msgid "GNU Guix in your field"
+msgstr ""
+
+#: apps/base/templates/home.scm:139
+msgid "Read some stories about how people are using GNU Guix in\ntheir daily lives."
+msgstr ""
+
+#: apps/base/templates/home.scm:150
+msgctxt "button"
+msgid "SOFTWARE DEVELOPMENT"
+msgstr ""
+
+#: apps/base/templates/home.scm:155
+msgctxt "button"
+msgid "BIOINFORMATICS"
+msgstr ""
+
+#: apps/base/templates/home.scm:160
+msgctxt "button"
+msgid "HIGH PERFORMANCE COMPUTING"
+msgstr ""
+
+#: apps/base/templates/home.scm:165
+msgctxt "button"
+msgid "RESEARCH"
+msgstr ""
+
+#: apps/base/templates/home.scm:170
+msgctxt "button"
+msgid "ALL FIELDS..."
+msgstr ""
+
+#: apps/base/templates/home.scm:177
+msgid "GNU Guix in other GNU/Linux distros"
+msgstr ""
+
+#: apps/base/templates/home.scm:189
+msgid "Video: <1>Demo of Guix in another GNU/Linux distribution<1.1/>https://audio-video.gnu.org/video/misc/2016-07__GNU_Guix_Demo_2.webm</1> (1 minute, 30 seconds)."
+msgstr ""
+
+#: apps/base/templates/home.scm:200
+msgid "If you don't use GNU Guix as a standalone GNU/Linux distribution, you still can use it as a package manager on top of any GNU/Linux distribution. This way, you can benefit from all its conveniences."
+msgstr ""
+
+#: apps/base/templates/home.scm:205
+msgid "Guix won't interfere with the package manager that comes with your distribution. They can live together."
+msgstr ""
+
+#: apps/base/templates/home.scm:212
+msgctxt "button"
+msgid "TRY IT OUT!"
+msgstr ""
+
+#: apps/base/templates/home.scm:219
+msgid "Blog"
+msgstr ""
+
+#: apps/base/templates/home.scm:226
+msgctxt "button"
+msgid "ALL POSTS"
+msgstr ""
+
+#: apps/base/templates/home.scm:239
+msgctxt "button"
+msgid "ALL CONTACT MEDIA"
+msgstr ""
+
+#: apps/base/templates/theme.scm:73 apps/base/templates/theme.scm:75
+msgctxt "webpage title"
+msgid "GNU Guix"
+msgstr ""
+
+#: apps/base/templates/theme.scm:97
+msgctxt "webpage title"
+msgid "GNU Guix — Activity Feed"
+msgstr ""
+
+#: apps/base/templates/theme.scm:114
+msgid "Made with <1>♥</1> by humans and powered by <2>GNU Guile</2>.  <3>Source code</3> under the <4>GNU AGPL</4>."
+msgstr ""
-- 
2.22.0


[-- Attachment #7: 0006-website-Add-German-translation.patch --]
[-- Type: text/plain, Size: 17307 bytes --]

From b8e73093b194b894e02bc8ae16b8efb3182a2a65 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Thu, 8 Aug 2019 00:08:47 +0200
Subject: [PATCH 6/6] website: Add German translation.

* website/po/de.po: New file.
* website/po/LINGUAS: Add de_DE lingua.
---
 website/po/LINGUAS |   1 +
 website/po/de.po   | 439 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 440 insertions(+)
 create mode 100644 website/po/de.po

diff --git a/website/po/LINGUAS b/website/po/LINGUAS
index 7741b83..782116d 100644
--- a/website/po/LINGUAS
+++ b/website/po/LINGUAS
@@ -1 +1,2 @@
+de_DE
 en_US
diff --git a/website/po/de.po b/website/po/de.po
new file mode 100644
index 0000000..2770884
--- /dev/null
+++ b/website/po/de.po
@@ -0,0 +1,439 @@
+# German translations for guix-website package.
+# Copyright (C) 2019 Ludovic Courtès
+# This file is distributed under the same license as the guix-website package.
+# Florian Pelz <pelzflorian@pelzflorian.de>, 2019.
+#
+msgid ""
+msgstr ""
+"Project-Id-Version: guix-website\n"
+"Report-Msgid-Bugs-To: ludo@gnu.org\n"
+"POT-Creation-Date: 2019-08-07 23:03+0200\n"
+"PO-Revision-Date: 2019-08-07 22:37+0200\n"
+"Last-Translator: Florian Pelz <pelzflorian@pelzflorian.de>\n"
+"Language-Team: none\n"
+"Language: de\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"Plural-Forms: nplurals=2; plural=(n != 1);\n"
+
+#: apps/base/templates/about.scm:16
+msgid "About"
+msgstr "Über Guix"
+
+#: apps/base/templates/about.scm:18 apps/base/templates/home.scm:20
+msgid ""
+"Guix is an advanced distribution of the GNU operating system.\n"
+"   Guix is technology that respects the freedom of computer users.\n"
+"   You are free to run the system for any purpose, study how it\n"
+"   works, improve it, and share it with the whole world."
+msgstr ""
+"Guix ist eine fortgeschrittene Distribution des GNU-Betriebssystems.\n"
+"   Guix ist eine Technologie, die die Freiheit der Benutzer von "
+"Rechengeräten respektiert.\n"
+"   Es steht Ihnen frei, das System zu jedem Zweck auszuführen, seine "
+"Funktionsweise zu studieren,\n"
+"   es zu verbessern, und es mit der ganzen Welt zu teilen."
+
+#. TRANSLATORS: |-separated list of webpage keywords
+#: apps/base/templates/about.scm:24
+msgid ""
+"GNU|Linux|Unix|Free software|Libre software|Operating system|GNU Hurd|GNU "
+"Guix package manager"
+msgstr ""
+"GNU|Linux|Unix|Freie Software|Libre-Software|Betriebssystem|GNU Hurd|GNU-"
+"Guix-Paketverwaltung"
+
+#: apps/base/templates/about.scm:26 apps/base/templates/about.scm:29
+#: apps/base/templates/components.scm:302 apps/base/templates/contact.scm:26
+msgctxt "Website menu"
+msgid "About"
+msgstr "Über Guix"
+
+#: apps/base/templates/about.scm:34
+msgid "About the Project"
+msgstr "Über das Projekt"
+
+#: apps/base/templates/about.scm:36
+msgid ""
+"The <1>GNU Guix</1> package and system manager is a <2>free software</2> "
+"project developed by volunteers around the world under the\n"
+"            umbrella of the <3>GNU Project</3>. "
+msgstr ""
+"<1>GNU Guix</1>, ein Programm zur Verwaltung von Paketen und Systemen, ist "
+"ein <2>Freie-Software-Projekt</2>, das von Freiwilligen aus der ganzen Welt "
+"im Rahmen des <3>GNU-Projekts</3> entwickelt wird. "
+
+#: apps/base/templates/about.scm:45
+msgid ""
+"Guix System is an advanced distribution of the <1>GNU operating system</1>.  "
+"It uses the <2>Linux-libre</2> kernel, and support for <3>the Hurd</3> is "
+"being worked on.  As a GNU distribution, it is committed\n"
+"            to respecting and enhancing <4>the freedom of its users</4>.  As "
+"such, it adheres to the <5>GNU Free System Distribution Guidelines</5>."
+msgstr ""
+"„Guix System“ ist eine fortgeschrittene Distribution des <1>GNU-"
+"Betriebssystems</1>. Es verwendet <2>Linux-libre</2> als seinen Kernel; an "
+"Unterstützung für <3>GNU Hurd</3> wird gearbeitet. Als GNU-Distribution "
+"gehört es zu seiner Zielsetzung, <4>die Freiheit seiner Nutzer</4> zu "
+"respektieren und zu vermehren. Daher folgt es den <5>Richtlinien für Freie "
+"Systemdistributionen</5>."
+
+#: apps/base/templates/about.scm:61
+msgid ""
+"GNU Guix provides <1>state-of-the-art package management features</1> such "
+"as transactional upgrades and roll-backs, reproducible\n"
+"            build environments, unprivileged package management, and\n"
+"            per-user profiles.  It uses low-level mechanisms from the "
+"<2>Nix</2> package manager, but packages are <3>defined</3> as native "
+"<4>Guile</4> modules, using extensions to the <5>Scheme</5> language—which "
+"makes it nicely hackable."
+msgstr ""
+"GNU Guix bietet <1>Paketverwaltungsfunktionalitäten auf dem Stand der "
+"Technik</1>, wie etwa transaktionelle Aktualisierungen und Rücksetzungen, "
+"reproduzierbare Erstellungsumgebungen, eine „unprivilegierte“ "
+"Paketverwaltung für Nutzer ohne besondere Berechtigungen sowie ein eigenes "
+"Paketprofil für jeden Nutzer. Dazu verwendet es dieselben Mechanismen, die "
+"dem Paketverwaltungsprogramm <2>Nix</2> zu Grunde liegen, jedoch werden "
+"Pakete als reine <4>Guile</4>-Module <3>definiert</3>. Dazu erweitert Guix "
+"die <5>Scheme</5>-Programmiersprache, wodurch es leicht ist, selbst an "
+"diesen zu hacken."
+
+#: apps/base/templates/about.scm:78
+msgid ""
+"Guix takes that a step further by additionally supporting stateless,\n"
+"           reproducible <1>operating system configurations</1>. This time "
+"the whole system is hackable in Scheme, from the <2>initial RAM disk</2> to "
+"the <3>initialization system</3>, and to the <4>system services</4>."
+msgstr ""
+"Guix geht dabei noch einen Schritt weiter, indem es zusätzlich noch "
+"zustandslose, reproduzierbare <1>Betriebssystemkonfigurationen</1> "
+"unterstützt. In diesem Fall kann am ganzen System in Scheme gehackt werden, "
+"von der <2>initialen RAM-Disk</2> bis hin zum <3>Initialisierungssystem</3> "
+"und den <4>Systemdiensten</4>."
+
+#: apps/base/templates/about.scm:96
+msgid "Maintainer"
+msgstr "Betreuer"
+
+#: apps/base/templates/about.scm:98
+msgid ""
+"Guix is currently maintained by Ludovic Courtès and Ricardo\n"
+"          Wurmus.  Please use the <1>mailing lists</1> for contact. "
+msgstr ""
+"Die Betreuer („Maintainer“) von Guix sind zur Zeit Ludovic Courtès und "
+"Ricardo Wurmus. Benutzen Sie bitte die <1>Mailing-Listen</1>, um Kontakt "
+"aufzunehmen."
+
+#: apps/base/templates/about.scm:106
+msgid "Licensing"
+msgstr "Lizenzierung"
+
+#: apps/base/templates/about.scm:108
+msgid ""
+"Guix is free software; you can redistribute it and/or modify\n"
+"          it under the terms of the <1>GNU General Public License</1> as "
+"published by the Free Software Foundation; either\n"
+"          version 3 of the License, or (at your option) any later\n"
+"          version. "
+msgstr ""
+"Guix ist freie Software. Sie können es weitergeben und/oder verändern, "
+"solange Sie sich an die Regeln der <1>GNU General Public License</1> halten, "
+"so wie sie von der Free Software Foundation festgelegt wurden; entweder in "
+"Version 3 der Lizenz oder (nach Ihrem Ermessen) in jeder neueren Version."
+
+#: apps/base/templates/components.scm:45
+msgid "Your location:"
+msgstr "Sie befinden sich hier:"
+
+#: apps/base/templates/components.scm:47
+msgid "Home"
+msgstr "Hauptseite"
+
+#: apps/base/templates/components.scm:150
+msgid "archive"
+msgstr "Archiv"
+
+#: apps/base/templates/components.scm:289
+msgctxt "Website menu"
+msgid "Guix"
+msgstr "Guix"
+
+#: apps/base/templates/components.scm:293
+msgid "Website menu:"
+msgstr "Menü des Webauftritts:"
+
+#: apps/base/templates/components.scm:295 apps/base/templates/home.scm:30
+msgctxt "Website menu"
+msgid "Overview"
+msgstr "Übersicht"
+
+#: apps/base/templates/components.scm:296
+msgctxt "Website menu"
+msgid "Download"
+msgstr "Herunterladen"
+
+#: apps/base/templates/components.scm:297
+msgctxt "Website menu"
+msgid "Packages"
+msgstr "Pakete"
+
+#: apps/base/templates/components.scm:298
+msgctxt "Website menu"
+msgid "Blog"
+msgstr "Blog"
+
+#: apps/base/templates/components.scm:299
+msgctxt "Website menu"
+msgid "Help"
+msgstr "Hilfe"
+
+#: apps/base/templates/components.scm:300
+msgctxt "Website menu"
+msgid "Donate"
+msgstr "Spenden"
+
+#: apps/base/templates/components.scm:305 apps/base/templates/contact.scm:31
+msgctxt "Website menu"
+msgid "Contact"
+msgstr "Kontakt"
+
+#: apps/base/templates/components.scm:306
+msgctxt "Website menu"
+msgid "Contribute"
+msgstr "Mitmachen"
+
+#: apps/base/templates/components.scm:307
+msgctxt "Website menu"
+msgid "Security"
+msgstr "Sicherheit"
+
+#: apps/base/templates/components.scm:308
+msgctxt "Website menu"
+msgid "Graphics"
+msgstr "Grafiken"
+
+#: apps/base/templates/components.scm:326
+msgid " (Page <1/> of <2/>)"
+msgstr " (Seite <1/> von <2/>)"
+
+#: apps/base/templates/components.scm:350
+msgid "Page <1/> of <2/>. Go to another page: "
+msgstr "Seite <1/> von <2/>. Besuchen Sie eine andere Seite: "
+
+#: apps/base/templates/contact.scm:17 apps/base/templates/contact.scm:36
+#: apps/base/templates/home.scm:232
+msgid "Contact"
+msgstr "Kontakt"
+
+#: apps/base/templates/contact.scm:19
+msgid ""
+"A list of channels to communicate with GNU Guix users\n"
+"   and developers about anything you want."
+msgstr ""
+"Eine Liste der Kanäle, auf denen Sie mit Nutzern und Entwicklern von "
+"GNU Guix reden können, worüber Sie möchten."
+
+#. TRANSLATORS: |-separated list of webpage keywords
+#: apps/base/templates/contact.scm:23
+msgid ""
+"GNU|Linux|Unix|Free software|Libre software|Operating system|GNU Hurd|GNU "
+"Guix package manager|Community|Mailing lists|IRC\n"
+"channels|Bug reports|Help"
+msgstr ""
+"GNU|Linux|Unix|Freie Software|Libre-Software|Betriebssystem|GNU Hurd|GNU-"
+"Guix-Paketverwaltung|Gemeinde|Community|Mailing-Listen|IRC-Kanäle|Probleme "
+"melden|Hilfe"
+
+#: apps/base/templates/home.scm:18
+msgid "GNU's advanced distro and transactional package manager"
+msgstr "GNUs fortgeschrittene Distribution und transaktionelle Paketverwaltung"
+
+#. TRANSLATORS: |-separated list of webpage keywords
+#: apps/base/templates/home.scm:26
+msgid ""
+"GNU|Linux|Unix|Free software|Libre software|Operating system|GNU Hurd|GNU "
+"Guix package manager|GNU Guile|Guile Scheme|Transactional upgrades|"
+"Functional package management|Reproducibility"
+msgstr ""
+"GNU|Linux|Unix|Freie Software|Libre-Software|Betriebssystem|GNU Hurd|GNU-"
+"Guix-Paketverwaltung|GNU Guile|Guile Scheme|Transaktionelle Aktualisierungen|"
+"Funktionale Paketverwaltung|Reproduzierbarkeit"
+
+#: apps/base/templates/home.scm:39
+msgid "Summary"
+msgstr "Zusammenfassung"
+
+#: apps/base/templates/home.scm:41
+msgid ""
+"<1>Liberating.</1> Guix is an advanced distribution of the <2>GNU operating "
+"system</2> developed by the <3>GNU Project</3>—which respects the <4>freedom "
+"of computer users</4>. "
+msgstr ""
+"<1>Befreiend.</1> Guix ist eine fortgeschrittende Distribution des <2>GNU-"
+"Betriebssystems</2>, das vom <3>GNU-Projekt</3> entwickelt wurde und die "
+"<4>Freiheit der Benutzer von Rechengeräten</4> respektiert. "
+
+#: apps/base/templates/home.scm:59
+msgid ""
+"<1>Dependable.</1> Guix <2>supports</2> transactional upgrades and roll-"
+"backs, unprivileged package management, <3>and more</3>.  When used as a "
+"standalone distribution, Guix supports <4>declarative system "
+"configuration</4> for transparent and reproducible operating systems."
+msgstr ""
+"<1>Verlässlich.</1> Guix <2>unterstützt</2> transaktionelle Aktualisierungen "
+"und Rücksetzungen, „unprivilegierte“ Paketverwaltung für Nutzer ohne "
+"besondere Berechtigungen <3>und noch mehr</3>. Wenn es als eigenständige "
+"Distribution verwendet wird, unterstützt Guix eine <4>deklarative "
+"Konfiguration des Systems</4> für transparente und reproduzierbare "
+"Betriebssysteme."
+
+#: apps/base/templates/home.scm:77
+msgid ""
+"<1>Hackable.</1> It provides <2>Guile Scheme</2> APIs, including high-level "
+"embedded domain-specific languages (EDSLs) to <3>define packages</3> and "
+"<4>whole-system configurations</4>."
+msgstr ""
+"<1>Hackbar.</1> Programmierschnittstellen (APIs) in <2>Guile Scheme</2> "
+"werden zur Verfügung gestellt, einschließlich hochsprachlicher eingebetteter "
+"domänenspezifischer Sprachen (Embedded Domain-Specific Languages, EDSLs), "
+"mit denen Sie <3>Pakete definieren</3> und <4>Konfigurationen des gesamten "
+"Systems</4> festlegen können."
+
+#: apps/base/templates/home.scm:99
+msgctxt "button"
+msgid "DOWNLOAD v<1/>"
+msgstr "v<1/> HERUNTERLADEN"
+
+#: apps/base/templates/home.scm:104
+msgctxt "button"
+msgid "CONTRIBUTE"
+msgstr "MITMACHEN"
+
+#: apps/base/templates/home.scm:111
+msgid "Discover Guix"
+msgstr "Entdecken Sie Guix"
+
+#: apps/base/templates/home.scm:113
+msgid ""
+"Guix comes with thousands of packages which include applications, system "
+"tools, documentation, fonts, and other digital goods readily available for "
+"installing with the <1>GNU Guix</1> package manager."
+msgstr ""
+"Mit Guix kommen Tausende von Paketen. Dazu gehören Anwendungen, "
+"Systemwerkzeuge, Dokumentation, Schriftarten, sowie andere digitale Güter, "
+"die jederzeit zur Installation mit dem Paketverwaltungswerkzeug <1>GNU "
+"Guix</1> bereitstehen."
+
+#: apps/base/templates/home.scm:130
+msgctxt "button"
+msgid "ALL PACKAGES"
+msgstr "ALLE PAKETE"
+
+#: apps/base/templates/home.scm:137
+msgid "GNU Guix in your field"
+msgstr "GNU Guix in Ihrem Bereich"
+
+#: apps/base/templates/home.scm:139
+msgid ""
+"Read some stories about how people are using GNU Guix in\n"
+"their daily lives."
+msgstr ""
+"Lesen Sie ein paar Erfahrungen, wie die Leute GNU Guix in\n"
+"ihrem täglichen Leben benutzen."
+
+#: apps/base/templates/home.scm:150
+msgctxt "button"
+msgid "SOFTWARE DEVELOPMENT"
+msgstr "SOFTWARE-ENTWICKLUNG"
+
+#: apps/base/templates/home.scm:155
+msgctxt "button"
+msgid "BIOINFORMATICS"
+msgstr "BIOINFORMATIK"
+
+#: apps/base/templates/home.scm:160
+msgctxt "button"
+msgid "HIGH PERFORMANCE COMPUTING"
+msgstr "HOCHLEISTUNGSRECHNEN"
+
+#: apps/base/templates/home.scm:165
+msgctxt "button"
+msgid "RESEARCH"
+msgstr "FORSCHUNG"
+
+#: apps/base/templates/home.scm:170
+msgctxt "button"
+msgid "ALL FIELDS..."
+msgstr "ALLE BEREICHE …"
+
+#: apps/base/templates/home.scm:177
+msgid "GNU Guix in other GNU/Linux distros"
+msgstr "GNU Guix auf anderen GNU/Linux-Distributionen"
+
+#: apps/base/templates/home.scm:189
+msgid ""
+"Video: <1>Demo of Guix in another GNU/Linux distribution<1.1/>https://audio-"
+"video.gnu.org/video/misc/2016-07__GNU_Guix_Demo_2.webm</1> (1 minute, 30 "
+"seconds)."
+msgstr ""
+"Video: <1>Vorführung von Guix auf einer anderen GNU/Linux-Distribution<1.1/"
+">https://audio-video.gnu.org/video/misc/2016-07__GNU_Guix_Demo_2.webm</1> (1 "
+"Minute, 30 Sekunden)."
+
+#: apps/base/templates/home.scm:200
+msgid ""
+"If you don't use GNU Guix as a standalone GNU/Linux distribution, you still "
+"can use it as a package manager on top of any GNU/Linux distribution. This "
+"way, you can benefit from all its conveniences."
+msgstr ""
+"Wenn Sie GNU Guix nicht als eine eigenständige GNU/Linux-Distribution "
+"verwenden, können Sie es trotzdem zur Paketverwaltung benutzen, aufgesetzt "
+"auf eine beliebige bestehende GNU/Linux-Distribution. Auf diese Weise können "
+"Sie all seine Vorteile genießen."
+
+#: apps/base/templates/home.scm:205
+msgid ""
+"Guix won't interfere with the package manager that comes with your "
+"distribution. They can live together."
+msgstr ""
+"Guix und das Paketverwaltungswerkzeug, das mit Ihrer Distribution "
+"ausgeliefert wird, werden sich gegenseitig nicht stören. Sie können "
+"friedlich koexistieren."
+
+#: apps/base/templates/home.scm:212
+msgctxt "button"
+msgid "TRY IT OUT!"
+msgstr "PROBIEREN SIE ES AUS!"
+
+#: apps/base/templates/home.scm:219
+msgid "Blog"
+msgstr "Blog"
+
+#: apps/base/templates/home.scm:226
+msgctxt "button"
+msgid "ALL POSTS"
+msgstr "ALLE EINTRÄGE"
+
+#: apps/base/templates/home.scm:239
+msgctxt "button"
+msgid "ALL CONTACT MEDIA"
+msgstr "ALLE KONTAKTMÖGLICHKEITEN"
+
+#: apps/base/templates/theme.scm:73 apps/base/templates/theme.scm:75
+msgctxt "webpage title"
+msgid "GNU Guix"
+msgstr "GNU Guix"
+
+#: apps/base/templates/theme.scm:97
+msgctxt "webpage title"
+msgid "GNU Guix — Activity Feed"
+msgstr "GNU Guix — Aktivitäten-Feed"
+
+#: apps/base/templates/theme.scm:114
+msgid ""
+"Made with <1>♥</1> by humans and powered by <2>GNU Guile</2>.  <3>Source "
+"code</3> under the <4>GNU AGPL</4>."
+msgstr ""
+"Mit <1>♥</1> von Menschen gemacht und durch <2>GNU Guile</2> ermöglicht. "
+"<3>Quellcode</3> unter der <4>GNU AGPL</4>."
-- 
2.22.0

Re: Website translation

[Ludovic Courtès]

Hi Florian,

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:

> On Mon, Aug 05, 2019 at 03:08:28PM +0200, pelzflorian (Florian Pelz) wrote:
>> I have implemented a working translation tool.  Sexp-xgettext
>> generates from an SHTML or other Scheme file with marked s-expressions
>> a POT file which can be translated and turned into an MO file from
>> which the code generates a localized HTML builder.  The advantage is
>> that existing SHTML will just have to be marked with G_ and no format
>> string has to be written, although sometimes the SHTML should be
>> adapted to produce a less complicated message in the POT file.  Find
>> attached an example of a marked Scheme file home.scm generating
>> guix-website.pot, which after manual translation generates the
>> attached guix.de_DE.html.

Very clever!

[...]

> Find attached patches that add internationalization support, mark the
> home and about pages for translation and add a sample German
> translation.  Feedback welcome.
>
> To use them, generate an MO file and run Haunt by following the
> instructions in i18n-howto.txt.  I have *not* written a Makefile to
> automate these steps.

It would be great to add the right steps to website/.guix.scm (in
guix-artwork.git).

> Sending these patches took longer because new bugs kept appearing.
> Probably new bugs will show up when marking more files for
> translation.  I will add more markings in the coming days if the
> patches are OK.
>
> I am unsure but I believe the URLs in href links should be marked with
> G_ as well so translators can change them to the URL of the respective
> translation of gnu.org, for example.  I will make these changes later
> if you agree.
>
> If this internationalization is to be deployed, the NGINX server
> offering guix.gnu.org would need to redirect according to
> Accept-Language headers.  I do not know if nginx alone can do this
> properly by now, otherwise there are Lua programs for nginx to handle
> Accept-Language or a custom Guile webserver could be written.

The nginx config is in guix-maintenance.git, but yeah, and I suspect
nginx alone can handle it.  We’ll see!

I haven’t reviewed in detail but the approach LGTM, so I’d be willing to
move forward on this.  Julien, sirgazil, Ricardo: WDYT?

We should make sure existing URLs are preserved.  Do you know if that’s
the case?

Also, I suppose we don’t translate URI paths themselves, right?  That’s
probably OK, at least as a first version.

Thanks for your work!

Ludo’.

Re: Website translation

[pelzflorian (Florian Pelz)]

On Thu, Aug 22, 2019 at 11:13:53PM +0200, Ludovic Courtès wrote:
> > If this internationalization is to be deployed, the NGINX server
> > offering guix.gnu.org would need to redirect according to
> > Accept-Language headers.  I do not know if nginx alone can do this
> > properly by now, otherwise there are Lua programs for nginx to handle
> > Accept-Language or a custom Guile webserver could be written.
> 
> The nginx config is in guix-maintenance.git, but yeah, and I suspect
> nginx alone can handle it.  We’ll see!
> 
> I haven’t reviewed in detail but the approach LGTM, so I’d be willing to
> move forward on this.  Julien, sirgazil, Ricardo: WDYT?
>

Then I will look at .guix.scm you mentioned (I did not notice that it
exists) and continue adding translations to the other files.

It would be nice if my code were simpler, but I do not know how and at
least it works.


> We should make sure existing URLs are preserved.  Do you know if that’s
> the case?
> 

Preserving URLs requires the above redirects based on the
Accept-Language HTTP headers.



> Also, I suppose we don’t translate URI paths themselves, right?  That’s
> probably OK, at least as a first version.
>

I do not understand.


> Thanks for your work!
> 
> Ludo’.

:)

Regards,
Florian

Re: Website translation

[Ludovic Courtès]

Hi,

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:

> On Thu, Aug 22, 2019 at 11:13:53PM +0200, Ludovic Courtès wrote:
>> > If this internationalization is to be deployed, the NGINX server
>> > offering guix.gnu.org would need to redirect according to
>> > Accept-Language headers.  I do not know if nginx alone can do this
>> > properly by now, otherwise there are Lua programs for nginx to handle
>> > Accept-Language or a custom Guile webserver could be written.
>> 
>> The nginx config is in guix-maintenance.git, but yeah, and I suspect
>> nginx alone can handle it.  We’ll see!
>> 
>> I haven’t reviewed in detail but the approach LGTM, so I’d be willing to
>> move forward on this.  Julien, sirgazil, Ricardo: WDYT?
>>
>
> Then I will look at .guix.scm you mentioned (I did not notice that it
> exists) and continue adding translations to the other files.
>
> It would be nice if my code were simpler, but I do not know how and at
> least it works.

That’s OK.

>> We should make sure existing URLs are preserved.  Do you know if that’s
>> the case?
>> 
>
> Preserving URLs requires the above redirects based on the
> Accept-Language HTTP headers.

So /(.*) should be redirected to /en/\1, right?

>> Also, I suppose we don’t translate URI paths themselves, right?  That’s
>> probably OK, at least as a first version.
>>
>
> I do not understand.

I mean “guix.gnu.org/en/help” could map to “guix.gnu.org/es/ayuda”, for
instance.  That’s not the case, right?

Thanks,
Ludo’.

Re: Website translation

[pelzflorian (Florian Pelz)]

On Fri, Aug 23, 2019 at 02:18:27PM +0200, Ludovic Courtès wrote:
> "pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:
> > On Thu, Aug 22, 2019 at 11:13:53PM +0200, Ludovic Courtès wrote:
> >> We should make sure existing URLs are preserved.  Do you know if that’s
> >> the case?
> >> 
> >
> > Preserving URLs requires the above redirects based on the
> > Accept-Language HTTP headers.
> 
> So /(.*) should be redirected to /en/\1, right?
> 
> >> Also, I suppose we don’t translate URI paths themselves, right?  That’s
> >> probably OK, at least as a first version.
> >>
> >
> > I do not understand.
> 
> I mean “guix.gnu.org/en/help” could map to “guix.gnu.org/es/ayuda”, for
> instance.  That’s not the case, right?
> 
> Thanks,
> Ludo’.

Now I understand.  Currently the code keeps the URLs and appends the
lingua, i.e. I want to keep the URLs as before and then make nginx
respond with the file help/index.es_ES.html to a request for
guix.gnu.org/help if the HTTP request has a header
Accept-Language: es.  <a href=…> would not need to be changed in the
translation.

We could of course translate the URLs instead, we would then add a
procedure url->localized-href that calls gettext to return the
localized URL for a given URL and replace each

(@ (href "/help"))

by

(@ ,(url->localized-href "/help"))

and add --keyword='url->localized-href' to the call to xgettext.  The
downside is that the logic for nginx would need to look up the
translation instead of looking up the locale, that the logic for Haunt
would need to look up the filename in the localized builder for pages,
and that the translator would need to translate all of "/help",
"../help", "../../help" etc.

(There needs to be some mapping from the lingua “es” to the locale
identifier “es_ES.utf8” in the call to setlocale.  Currently the code
uses linguas like “es_ES” instead of “es”, which may or may not
complicate the logic for nginx, but this could easily be changed.)

Regards,
Florian

Re: Website translation

[Jelle Licht]

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:

> [snip]

> We could of course translate the URLs instead, we would then add a
> procedure url->localized-href that calls gettext to return the
> localized URL for a given URL and replace each
>
> (@ (href "/help"))
>
> by
>
> (@ ,(url->localized-href "/help"))
>
> and add --keyword='url->localized-href' to the call to xgettext.  The
> downside is that the logic for nginx would need to look up the
> translation instead of looking up the locale, that the logic for Haunt
> would need to look up the filename in the localized builder for pages,
> and that the translator would need to translate all of "/help",
> "../help", "../../help" etc.
>
> (There needs to be some mapping from the lingua “es” to the locale
> identifier “es_ES.utf8” in the call to setlocale.  Currently the code
> uses linguas like “es_ES” instead of “es”, which may or may not
> complicate the logic for nginx, but this could easily be changed.)

I think it would be important to make sure that these URLs do not change
after they are published for the first time, in order to make sure that
links to them still work at a later point. See [1] for more elaborate
arguments against changing URLs.

Being able to change (translated) URLs while also having the old URLs
redirecting to the new ones would be nice, but this seems like it would
actually be much more challenging to do with our current setup.

Is there a way in which to state that certain translations should only
be done once, and not change afterwards?

Regards,
Jelle

[1]: https://www.w3.org/Provider/Style/URI

Re: Website translation

[pelzflorian (Florian Pelz)]

On Fri, Aug 23, 2019 at 04:08:30PM +0200, Jelle Licht wrote:
> Is there a way in which to state that certain translations should only
> be done once, and not change afterwards?
> 

Yes, I agree.  A comment can be added to the POT file warning
translators not to change already translated URLs, which translators
hopefully would adhere to (?).  Since we would use a custom xgettext,
it is trivial to add such a comment to the POT.  When msginit creates
a PO file from the POT file, the comment is kept.

Nonetheless, I wonder how important translated URLs are.  Untranslated
URLs are valid for every language.  Invisible to the user,
guix.gnu.org responds with the right translation.  The disadvantage is
that users who do not speak English do not know directly what to
expect from the URL until they visit it.

Regards,
Florian

Re: Website translation

[pelzflorian (Florian Pelz)]

[-- Attachment #1: Type: text/plain, Size: 2814 bytes --]

On Thu, Aug 22, 2019 at 11:13:53PM +0200, Ludovic Courtès wrote:
> It would be great to add the right steps to website/.guix.scm (in
> guix-artwork.git).
> 

Even though the attached patches allow building with .guix.scm, I
found that my previous code does not work correctly.  The
deconstruction of the translation into an sexp happened at macro
expansion time before the evaluation phase when setlocale calls took
effect, so both or neither of index.en_US.html and index.de_DE.html
contained the German translation, depending on the system-wide locale
setting.

I tried to move the deconstruction to the evaluation phase by using
local-eval:

(define (sgettext x)
  "After choosing an identifier for marking s-expressions for
translation, make it usable by defining a macro with it calling
sgettext.  If for example the chosen identifier is G_,
use (define-syntax G_ sgettext)."
  (syntax-case x ()
    ((_ exp)
     (let ((msgstr (sexp->msgid (syntax->datum #'exp))))
       #`(local-eval (pk (deconstruct (syntax->datum #'exp)
                                      (gettext #,msgstr)))
                     (the-environment))))))

which almost works, except it seems (but I am unsure) the-environment
captures the wrong environment, so functions are missing.  I see:

ERROR: In procedure %resolve-variable:
error: gnu-url: unbound variable
building pages in '/tmp/gnu.org/software/guix'...

;;; ((quasiquote (h2 (@ (class "a11y-offset")) "Menü des Webauftritts:")))

;;; ((quasiquote (footer "Mit " (unquote (quasiquote (span (@ (class "metta")) "♥"))) " von Menschen gemacht und durch " (unquote (quasiquote (a (@ (class "link-yellow") (href (unquote (gnu-url "software/guile/")))) "GNU Guile"))) " ermöglicht. " (unquote (quasiquote (a (@ (class "link-yellow") (href "//git.savannah.gnu.org/cgit/guix/guix-artwork.git/tree/website")) "Quellcode"))) " unter der " (unquote (quasiquote (a (@ (class "link-yellow") (href (unquote (gnu-url "licenses/agpl-3.0.html")))) "GNU AGPL"))) ".")))


I try to find a minimal example.  I add the following to the pristine
guix-website (with only my first patch):

diff --git a/website/apps/base/templates/theme.scm b/website/apps/base/templates/theme.scm
index ecb27ef..b993c2a 100644
--- a/website/apps/base/templates/theme.scm
+++ b/website/apps/base/templates/theme.scm
@@ -106,6 +106,9 @@
       ,(navbar #:active-item active-menu-item)
 
       ,(if (null? crumbs) "" (breadcrumbs crumbs))
+      ,(pk (let ()
+             (use-modules (ice-9 local-eval))
+             (local-eval '(gnu-url) (the-environment))))
 
       ,content
       (footer


It crashes with

ERROR: In procedure %resolve-variable:
error: local-eval: unbound variable


I will continue investigating.

Regards,
Florian

[-- Attachment #2: 0007-website-Make-building-with-.guix.scm-work-with-multi.patch --]
[-- Type: text/plain, Size: 999 bytes --]

From 26d1bc2c1cea8742640be0e2b307a2e4c0397095 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Sat, 24 Aug 2019 21:27:50 +0200
Subject: [PATCH 7/8] website: Make building with .guix.scm work with multiple
 linguas.

* website/.guix.scm: Make Haunt build directory writable so Haunt can
overwrite duplicate assets.
---
 website/.guix.scm | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/website/.guix.scm b/website/.guix.scm
index 068ef0d..5eb48b6 100644
--- a/website/.guix.scm
+++ b/website/.guix.scm
@@ -48,6 +48,11 @@
 
           (copy-recursively #$source ".")
 
+          ;; Make the copy writable so Haunt can overwrite duplicate assets.
+          (invoke #+(file-append (specification->package "coreutils")
+                                 "/bin/chmod")
+                  "--recursive" "u+w" ".")
+
           ;; For Haunt.
           (setenv "GUILE_LOAD_PATH" (string-join %load-path ":"))
           (setenv "GUILE_LOAD_COMPILED_PATH"
-- 
2.22.0


[-- Attachment #3: 0008-website-Have-.guix.scm-create-MO-files-for-translati.patch --]
[-- Type: text/plain, Size: 2561 bytes --]

From e367d7ba09d901c9ad4b54b919de2e3a10ba5791 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Sun, 25 Aug 2019 11:59:24 +0200
Subject: [PATCH 8/8] website: Have .guix.scm create MO files for translation.

website/.guix.scm: Convert PO files to MO files for each lingua.
---
 website/.guix.scm | 34 +++++++++++++++++++++++++++++++++-
 1 file changed, 33 insertions(+), 1 deletion(-)

diff --git a/website/.guix.scm b/website/.guix.scm
index 5eb48b6..4a70f6a 100644
--- a/website/.guix.scm
+++ b/website/.guix.scm
@@ -21,7 +21,8 @@
 (use-modules (guix) (gnu)
              (guix modules)
              (guix git-download)
-             (ice-9 match))
+             (ice-9 match)
+             (ice-9 rdelim))
 
 (define this-directory
   (dirname (current-filename)))
@@ -36,6 +37,14 @@
     (((labels packages) ...)
      (cons package packages))))
 
+(define linguas
+  (with-input-from-file "po/LINGUAS"
+    (lambda _
+      (let loop ((line (read-line)))
+        (if (eof-object? line)
+            '()
+            (cons line (loop (read-line))))))))
+
 (define build
   (with-extensions (append (package+propagated-inputs
                             (specification->package "guix"))
@@ -53,6 +62,29 @@
                                  "/bin/chmod")
                   "--recursive" "u+w" ".")
 
+          ;; For translations, create MO files from PO files.
+          (for-each
+           (lambda (lingua)
+             (let* ((msgfmt #+(file-append (specification->package "gettext")
+                                           "/bin/msgfmt"))
+                    (lingua-file (string-append "po/" lingua ".po"))
+                    (lang (car (string-split lingua #\_)))
+                    (lang-file (string-append "po/" lang ".po")))
+               (define (create-mo filename)
+                 (begin
+                   (invoke msgfmt filename)
+                   (mkdir-p (string-append lingua "/LC_MESSAGES"))
+                   (rename-file "messages.mo"
+                                (string-append lingua "/LC_MESSAGES/"
+                                               "guix-website.mo"))))
+               (cond
+                ((file-exists? lingua-file)
+                 (create-mo lingua-file))
+                ((file-exists? lang-file)
+                 (create-mo lang-file))
+                (else #t))))
+           (list #$@linguas))
+
           ;; For Haunt.
           (setenv "GUILE_LOAD_PATH" (string-join %load-path ":"))
           (setenv "GUILE_LOAD_COMPILED_PATH"
-- 
2.22.0

Re: Website translation

[pelzflorian (Florian Pelz)]

On Sun, Aug 25, 2019 at 08:58:31PM +0200, pelzflorian (Florian Pelz) wrote:
> On Thu, Aug 22, 2019 at 11:13:53PM +0200, Ludovic Courtès wrote:
> > It would be great to add the right steps to website/.guix.scm (in
> > guix-artwork.git).
> > 
> 
> Even though the attached patches allow building with .guix.scm, I
> found that my previous code does not work correctly.  The
> deconstruction of the translation into an sexp happened at macro
> expansion time before the evaluation phase when setlocale calls took
> effect, so both or neither of index.en_US.html and index.de_DE.html
> contained the German translation, depending on the system-wide locale
> setting.
> 

I will change it so `haunt build` only builds the website only for the
currently set locale.  .guix.scm will call `haunt build` once for each
lingua.

Regards,
Florian

Re: Website translation

[pelzflorian (Florian Pelz)]

I will continue this discussion at
<https://issues.guix.info/issue/26302>.

Regards,
Florian

Re: Website translation

[sirgazil]

---- On Thu, 18 Jul 2019 10:08:36 -0500 pelzflorian (Florian Pelz) <pelzflorian@pelzflorian.de> wrote ----

 > On Wed, Jul 17, 2019 at 11:16:21PM +0200, Ludovic Courtès wrote: 
 > > I think we now have an overview of the possibilities (including maybe 
 > > ‘itstool’ that Ricardo mentions.)  I’d say that whoever is interested 
 > > should give it a try with what looks like the most promising approach 
 > > and report back with a prototype.  :-) 
 > > 
 >  
 > I tried to make gettext usable (not yet implementing any discussed 
 > approach), but it is a little rough: I tried using msgctxts.  Sadly 
 > Guile is missing a pgettext function, I think.  Should I use Guile’s 
 > ffi?  I think msgctxts could help with fragmentation, as I would 
 > prefer format strings with msgctxt over HTML-that-is-not-SHTML with 
 > itstool (I may misunderstand itstool though). 


I faced the same problem. With the current  gettext tools in Guile, I couldn't find any way to solve ambiguities.


 > sirgazil (Cc), long ago at 
 > <https://lists.gnu.org/archive/html/guile-user/2017-12/msg00071.html> 
 > you said you had written an interleave function for format strings. 
 > Do you have the code somewhere?  I see in the commit log you are still 
 > actively working on the Guix website. 


Yes, the function is here:

https://gitlab.com/sirgazil/guile-lab/blob/master/glab/i18n.scm

I use it for my own websites

http://sirgazil.bitbucket.io/
https://sirgazil.gitlab.io/golea/

But I use it to get things done.


 > Also, I believe this discussion is actually 
 > <https://issues.guix.info/issue/26302>.  Should I reference this 
 > thread there? 
 >  
 > Regards, 
 > Florian

Re: Website translation

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> As long as we use xgettext, we have to stick to a format-string-like
> approach like what sirgazil proposes.
>
> Writing a custom xgettext kind of tool wouldn’t help much because
> gettext is fundamentally text oriented: you give it a string and it
> returns a string.
>
> So I think the alternative is:
>
>   • use gettext, and in that case stick to a format-string-like
>     mechanism, or:
>
>   • use a completely new tool that would be able to consume and produce
>     sexps (trees).
>
> The latter doesn’t seem reasonable to me.  :-)

I’m not sure I understand the problem well enough, but there seems to be
a middle way: using itstool with XML.  When you squint really hard XML
is close to S-exprs.

--
Ricardo

Re: Website translation

[pelzflorian (Florian Pelz)]

On Thu, Jul 11, 2019 at 05:15:11PM +0200, Ludovic Courtès wrote:
> sirgazil proposed a solution that’s similar to format strings to address
> that:
> 
>   https://lists.gnu.org/archive/html/guile-user/2017-12/msg00071.html
> 

One further comment: For fragmented translations, one maybe could use
a msgcontext like g_dpgettext at
<https://gitlab.gnome.org/GNOME/glib/blob/master/glib/ggettext.c> to
avoid fragmentation.

Regards,
Florian