projects/guix·blob master · refs

78 lines · 2.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2025 Florian Pelz <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19;; Minify Gettext PO files when synced from
20;; <https://codeberg.org/guix/translations/>,
21;; keeping only actually translated messages.
22
23;; Note: This does not work for PO files of the guix domain, which needed
24;; support for plural forms in (@ (guix build po) read-po-file). The guix
25;; domain's files are comparatively small and the read-po-file API would
26;; have to be expanded to use records or such; it is not worth it.
27
28(use-modules (guix build po)
29 (ice-9 match)
30 (ice-9 textual-ports))
31
32(define (escape str)
33 "Escape msgid or msgstr. Replace by C-style escape sequences."
34 (let* ((in (open-input-string str))
35 (text (get-string-all in))
36 (escaped-text-as-list
37 (string-fold-right
38 (lambda (char result)
39 (cons (case char
40 ((#\") "\\\"")
41 ((#\\) "\\\\")
42 ((#\linefeed) "\\n")
43 ((#\return) "\\r")
44 ((#\tab) "\\t")
45 (else (string char)))
46 result))
47 '()
48 text))
49 (escaped-text (apply string-append escaped-text-as-list)))
50 (display escaped-text)))
51
52(match (command-line)
53 ((program pofile)
54 (let ((input (open-input-file pofile)))
55 ;; Just copy until an empty line.
56 (letrec ((copy
57 (lambda ()
58 (let ((next-line (get-line input)))
59 (display next-line)
60 (newline)
61 (when (> (string-length next-line) 0)
62 (copy))))))
63 (copy))
64 ;; Then print only translated messages.
65 (for-each
66 (lambda (msg)
67 (match msg
68 ((msgid . msgstr)
69 (display "msgid \"")
70 (escape msgid)
71 (display "\"")
72 (newline)
73 (display "msgstr \"")
74 (escape msgstr)
75 (display "\"")
76 (newline)
77 (newline))))
78 (read-po-file input)))))