guix-play/build-aux/mdate-from-git.scm
Janneke Nieuwenhuizen 2b8a2a6e72
maint: Generate doc/version[-LANG].texi using `mdate-from-git.scm'.
This replaces Automake's `build-aux/mdate-sh' with our own
`build-aux/mdate-from-git.scm' to use reproducible timestamps from Git
instead.

* build-aux/mdate-from-git.scm: New script.
* bootstrap: Use it to replace build-aux/mdate-sh.
* Makefile.am (EXTRA_DIST): Add it.

Change-Id: I17d0a7de9ffea397129c0db1728f86e28a4e245f
2024-04-19 16:45:41 +02:00

90 lines
3.3 KiB
Scheme
Executable File
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#! /bin/sh
# -*-scheme-*-
export LANG=C LANGUAGE=C LC_TIME=C
export TZ=UTC0
exec guile --no-auto-compile -L $srcdir -C $srcdir -e '(mdate-from-git)' -s "$0" "$@"
!#
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; This program 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.
;;;
;;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;;; Commentary:
;;;
;;; Usage: mdate-from-git.scm FILE
;;;
;;; This script is compatible with Automake's `mdate-sh' but uses the timestamp
;;; from Git instead of from the file system. Also, it can be appended to
;;; mdate-sh.
;;; As a special exception for Guix, it caters for doc/guix.LANG.texi files that
;;; are not stored in Git, by using po/doc/guix-manual.LANG.po for the Git
;;; timestamp. Test doing something like:
;;;
;;; build-aux/mdate-from-git.scm doc/guix.de.texi
;;;
;;;; Code:
(define-module (mdate-from-git)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:export (main))
(define (pipe-command command)
(let* ((port (apply open-pipe* OPEN_READ command))
(output (read-string port)))
(close-port port)
output))
(define (guix.LANG.texi->guix-manual.LANG.po file-name)
"Translated manuals doc/guix.LANG.texi are not tracked in Git and are
generated from po/doc/guix-manual.LANG.po. For such an untraced .TEXI file,
return its .PO counterpart."
(let ((m (string-match "doc/guix.([^.]+).texi" file-name)))
(if (not m) file-name
(let ((lang (match:substring m 1)))
(format #f "po/doc/guix-manual.~a.po" lang)))))
;;;
;;; Entry point.
;;;
(define (main args)
(match args
((script file-name)
(let* ((command `("git" "ls-files" "--error-unmatch" "--" ,file-name))
(tracked? (zero? (with-error-to-port (%make-void-port "w")
(lambda _
(with-output-to-port (%make-void-port "w")
(lambda _ (apply system* command)))))))
(file-name (if tracked? file-name
(guix.LANG.texi->guix-manual.LANG.po file-name)))
(command `("git" "log" "--pretty=format:%ct" "-n1" "--" ,file-name))
(timestamp (with-error-to-port (%make-void-port "w")
(lambda _ (pipe-command command))))
(source-date-epoch (or (getenv "SOURCE_DATE_EPOCH") "1"))
(timestamp (if (string-null? timestamp) source-date-epoch
timestamp))
(time (gmtime (string->number timestamp)))
(d-m-y (strftime "%-d %B %Y" time)))
(display d-m-y)))
(_
(format (current-error-port) "Usage: mdate-from-git.scm FILE\n")
(exit 2))))