unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Translating news on weblate?
@ 2022-07-21 20:27 Julien Lepiller
  2022-07-22 10:20 ` Taiju HIGASHI
                   ` (3 more replies)
  0 siblings, 4 replies; 6+ messages in thread
From: Julien Lepiller @ 2022-07-21 20:27 UTC (permalink / raw)
  To: guix-devel

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

Hi Guix!

I was thinking we could have our news file translated at weblate, which
would help having more people translate it. Attached is a script that
is able to generate a pot file from the news.scm file and a translated
news.scm file from the existing news.scm and a directory that contains
the po files and a LINGUAS file.

The goal is to regularly fetch the news.scm file, generate a new pot
that would automatically be updated on weblate. Translators can do
their work, and the result is regularly merged back (after being
checked that it doesn't break) in our repo.

The script tries to reformat the news in a standard way and to merge
existing copyright lines with the authorship lines in the po files. It
is also able to generate the initial po files that I would give
weblate, so translators don't have to redo translations that have
already been done.

I also attached the LINGUAS file with all languages for which we have
at least one entry in news.scm.

WDYT?

[-- Attachment #2: LINGUAS --]
[-- Type: application/octet-stream, Size: 18 bytes --]

de
es
fr
nl
ru
zh

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: news-po.scm --]
[-- Type: text/x-scheme, Size: 13086 bytes --]

#!/gnu/store/5rbr7gi8q7gpmb4gmqrpnpk55a4gjpkz-profile/bin/guile \
--no-auto-compile -s
!#

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This code is a helper for news file translation using Gettext.

;;; Code:

(use-modules (srfi srfi-1)
             (srfi srfi-9)
             (srfi srfi-19)
             (ice-9 match)
             (ice-9 pretty-print)
             (ice-9 rdelim)
             (ice-9 regex)
             (guix build po)
             (guix channels))

(define read-channel-news (@@ (guix channels) read-channel-news))
(define channel-news-entries (@@ (guix channels) channel-news-entries))
(define <channel-news-entry> (@@ (guix channels) <channel-news-entry>))
(define channel-news-entry (@@ (guix channels) channel-news-entry))

(define (print-msg msg)
  (if msg
    (let* ((msg (string-join (string-split msg #\\) "\\\\"))
           (msg (string-join (string-split msg #\") "\\\""))
           (msg (string-join (string-split msg #\newline)
                             "\\n\"\n\"")))
      (if (string-contains msg "\n") (string-append "\"\n\"" msg) msg))
    ""))

(define* (generate-po news-file pot-file #:optional lang)
  "Generate a pot file from a news file."
  (let ((news (call-with-input-file news-file read-channel-news)))
    (call-with-output-file pot-file
      (lambda (port)
        (format port "# SOME DESCRIPTIVE TITLE~%")
        (format port "# Copyright (C) YEAR the authors of Guix (msgids) and the following authors (msgstr)~%")
        (format port "# This file is distributed under the same license as the guix news file.~%")
        (format port "# ~%")
        (format port "msgid \"\"~%")
        (format port "msgstr \"\"
\"Project-Id-Version: guix news checkout\\n\"
\"Report-Msgid-Bugs-To: bug-guix@gnu.org\\n\"
\"POT-Creation-Date: ~a\\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\"~%~%" (date->string (current-date)))
        (for-each
          (match-lambda
            (($ <channel-news-entry> commit tag title body)
             (let ((msgid1 (assoc-ref title "en"))
                   (msgid2 (assoc-ref body "en"))
                   (msgstr1 (assoc-ref title lang))
                   (msgstr2 (assoc-ref body lang)))
               (when commit
                 (format port "#. commit: ~a~%" commit))
               (when tag
                 (format port "#. tag: ~a~%" tag))
               (format port "msgid \"~a\"~%" (print-msg msgid1))
               (format port "msgstr \"~a\"~%~%" (print-msg msgstr1))
               (when commit
                 (format port "#. commit: ~a~%" commit))
               (when tag
                 (format port "#. tag: ~a~%" tag))
               (format port "msgid \"~a\"~%" (print-msg msgid2))
               (format port "msgstr \"~a\"~%~%" (print-msg msgstr2)))))
          (channel-news-entries news))))))

(define (languages lingua)
  (with-input-from-file lingua
    (lambda _
      (let loop ((line (read-line)))
        (if (eof-object? line)
            '()
            ;; else read linguas before comment
            (let ((before-comment (car (string-split line #\#))))
              (append
               (map match:substring (list-matches "[^ \t]+" before-comment))
               (loop (read-line)))))))))

(define (clean-string entry)
  (string-join (string-split entry #\newline) "\n"))

(define (complete-msg entries pos)
  "Complete an entry's message list using po files that were parsed in pos."

  (let ((entry (assoc-ref entries "en")))
    (let loop ((pos pos) (entries entries))
      (match pos
        (() entries)
        (((lang . po) pos ...)
         (if (assoc-ref po entry)
           (loop pos (cons (cons lang (assoc-ref po entry)) entries))
           (loop pos entries)))))))

(define (merge-entries news pos languages)
  (let ((entries (channel-news-entries news)))
    (map
      (lambda (entry)
        (let* ((title (list (cons "en"
                                  (clean-string
                                    (assoc-ref (channel-news-entry-title entry)
                                               "en")))))
               (title (complete-msg title pos))
               (body (list (cons "en"
                                 (clean-string
                                   (assoc-ref (channel-news-entry-body entry)
                                              "en")))))
               (body (complete-msg body pos)))
          (channel-news-entry (channel-news-entry-commit entry)
                              (channel-news-entry-tag entry)
                              title body)))
      entries)))

(define-record-type <copyright>
  (make-copyright name years)
  copyright?
  (name copyright-name)
  (years copyright-years))

(define (parse-years years)
  (let ((years (map string-trim (string-split years #\,))))
    (let loop ((years years) (res '()))
      (match years
        (() (sort res <))
        ((year years ...)
         (match (string-split year #\-)
           ((year) (loop years (cons (string->number year) res)))
           ((start end)
            (let ((start (string->number start))
                  (end   (string->number end)))
              (loop years (append (iota (- end start -1) start) res))))))))))

(define (parse-scm-copyrights file)
  (with-input-from-file file
    (lambda _
      (let loop ((line (read-line)))
        (if (eof-object? line)
          '()
          (let ((matches (string-match "^;; Copyright © ([0-9, -]*) (.*)$" line)))
            (if matches
              (cons
                (make-copyright (match:substring matches 2)
                                (parse-years (match:substring matches 1)))
                (loop (read-line)))
              (loop (read-line)))))))))

(define (parse-po-copyrights file)
  (with-input-from-file file
    (lambda _
      (let loop ((line (read-line)))
        (if (eof-object? line)
          '()
          (let ((matches (string-match "^# (.* <.*@.*>), ([0-9, -]*)\\.$" line)))
            (if matches
              (cons
                (make-copyright (match:substring matches 1)
                                (parse-years (match:substring matches 2)))
                (loop (read-line)))
              (loop (read-line)))))))))

(define (merge-copyrights copyrights)
  (define (uniq lst)
    (match lst
      (() '())
      ((e lst ...)
       (let ((rest (uniq lst)))
         (if (member e rest)
           rest
           (cons e rest))))))

  (define (merge-copyright-of name copyrights)
    (make-copyright name (uniq (sort (apply append (map copyright-years copyrights)) <))))

  (fold
    (lambda (copyright res)
      (if (find (lambda (r) (equal? (copyright-name r) (copyright-name copyright))) res)
          (sort res (lambda (c1 c2) (string<=? (copyright-name c1) (copyright-name c2))))
          (cons
            (merge-copyright-of
              (copyright-name copyright)
              (filter
                (lambda (c)
                  (equal? (copyright-name c) (copyright-name copyright)))
                copyrights))
            res)))
    '()
    copyrights))


(define (parse-copyrights news-file po-dir languages)
  (let ((scm-copyrights (parse-scm-copyrights news-file))
        (po-copyrights
          (apply append
                 (map
                   (lambda (lang)
                     (parse-po-copyrights (string-append po-dir "/" lang ".po")))
                   languages))))
    (merge-copyrights (append scm-copyrights po-copyrights))))

(define (print-copyrights copyrights)
  (define (format-years years)
    (let loop ((years years) (first-consecutive #f) (last-consecutive #f) (res '()))
      (match years
        ((year years ...)
         (cond
           ((and first-consecutive
                 (equal? (+ last-consecutive 1) year))
            (loop years first-consecutive year res))
           ((and first-consecutive 
                 (equal? first-consecutive last-consecutive))
            (loop years year year (cons (number->string first-consecutive) res)))
           ((and first-consecutive 
                 (equal? (+ first-consecutive 1) last-consecutive))
            (loop years year year (cons* (number->string last-consecutive) (number->string first-consecutive) res)))
           (first-consecutive
            (loop years year year (cons (string-append number->string first-consecutive) "-" (number->string last-consecutive))))
           (else
            (loop years year year res))))
        (()
         (cond
           ((and first-consecutive
                 (equal? first-consecutive last-consecutive))
            (cons (number->string first-consecutive) res))
           ((and first-consecutive
                 (equal? (+ first-consecutive 1) last-consecutive))
            (cons* (number->string last-consecutive)
                   (number->string first-consecutive)
                   res))
           (first-consecutive
            (cons (string-append (number->string first-consecutive)
                                 "-"
                                 (number->string last-consecutive))
                  res)))))))

  (for-each
    (match-lambda
      (($ <copyright> name years)
       (format #t ";; Copyright © ~a ~a~%" (string-join (reverse (format-years years)) ", ") name)))
    copyrights))

(define (print-entry entry)
  (define (print-content content)
    (for-each
      (match-lambda
        ((lang . content)
         (let* ((content (string-join (string-split content #\\) "\\\\"))
                (content (string-join (string-split content #\") "\\\"")))
           (format #t "~%         (~a \"~a\")" lang content))))
      content))

  (define (content<=? c1 c2)
    (or (equal? (car c1) "en")
        (and
          (not (equal? (car c2) "en"))
          (string<=? (car c1) (car c2)))))

  (format #t "~%~% (entry ")
  (when (channel-news-entry-commit entry)
    (format #t "(commit \"~a\")~%" (channel-news-entry-commit entry)))
  (when (channel-news-entry-tag entry)
    (format #t "        (tag \"~a\")~%" (channel-news-entry-tag entry)))
  (format #t "        (title")
  (print-content (sort (channel-news-entry-title entry) content<=?))
  (display ")")
  (newline)
  (format #t "        (body")
  (print-content (sort (channel-news-entry-body entry) content<=?))
  (display "))"))

(define (merge-news news-file po-dir)
  (let* ((lingua (string-append po-dir "/LINGUAS"))
         (languages (languages lingua))
         (pos (map
                (lambda (lang)
                  (cons
                    lang
                    (call-with-input-file
                      (string-append po-dir "/" lang ".po")
                      read-po-file)))
                languages))
         (news (call-with-input-file news-file read-channel-news))
         (entries (merge-entries news pos languages))
         (copyrights (parse-copyrights news-file po-dir languages)))
    (with-output-to-file (string-append news-file ".tmp")
      (lambda _
        (display ";; GNU Guix news, for use by 'guix pull'.
;;
")
        (print-copyrights copyrights)
        (display ";;
;; Copying and distribution of this file, with or without modification, are
;; permitted in any medium without royalty provided the copyright notice and
;; this notice are preserved.

(channel-news
 (version 0)")
        (for-each print-entry entries)
        (display ")")
        (newline)))))

(define (main . args)
  (match args
    (("pot" news-file pot-file)
     (generate-po news-file pot-file))
    (("po" news-file lang po-file)
     (generate-po news-file po-file lang))
    (("merge" news-file po-dir)
     (merge-news news-file po-dir))
    (_
     (format (current-error-port)
             "Usage: etc/teams.scm <command> [<args>]~%"))))

(apply main (cdr (command-line)))

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2022-08-07 12:38 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-21 20:27 Translating news on weblate? Julien Lepiller
2022-07-22 10:20 ` Taiju HIGASHI
2022-07-28 14:09 ` Thiago Jung Bauermann
2022-08-03 18:00 ` Ludovic Courtès
2022-08-07 10:56 ` pelzflorian (Florian Pelz)
2022-08-07 11:55   ` Maxime Devos

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).