me
/
guix
Archived
1
0
Fork 0

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
master
Janneke Nieuwenhuizen 2024-04-14 09:42:25 +02:00
parent a47f228861
commit 2b8a2a6e72
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
3 changed files with 97 additions and 1 deletions

View File

@ -725,6 +725,7 @@ EXTRA_DIST += \
build-aux/convert-xref.scm \ build-aux/convert-xref.scm \
build-aux/generate-authors.scm \ build-aux/generate-authors.scm \
build-aux/git-version-gen \ build-aux/git-version-gen \
build-aux/mdate-from-git.scm \
build-aux/test-driver.scm \ build-aux/test-driver.scm \
build-aux/update-NEWS.scm \ build-aux/update-NEWS.scm \
build-aux/update-guix-package.scm \ build-aux/update-guix-package.scm \

View File

@ -24,4 +24,10 @@ for lang in ${langs}; do
fi fi
done done
exec autoreconf -vfi autoreconf -vfi
# Replace Automake's build-aux/mdate-sh with build-aux/mdate-from-git, our
# own, reproducible version.
chmod +w build-aux/mdate-sh
rm -f build-aux/mdate-sh
ln -s mdate-from-git.scm build-aux/mdate-sh

View File

@ -0,0 +1,89 @@
#! /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))))