aboutsummaryrefslogtreecommitdiff
# htmlxref.cnf - reference file for free Texinfo manuals on the web.
# Modified by Ludovic Courtès <ludo@gnu.org> for the GNU Guix manual.
# Further modified by Tomas Volf <~@wolfsden.cz>.

htmlxrefversion=2025-01-22.18; # UTC

# Copyright 2010-2020, 2022 Free Software Foundation, Inc.
#
# 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.
#
# The latest version of this file is available at
# http://ftpmirror.gnu.org/texinfo/htmlxref.cnf.
# Email corrections or additions to bug-texinfo@gnu.org.
# The primary goal is to list all relevant GNU manuals;
# other free manuals are also welcome.
#
# To be included in this list, a manual must:
#
# - have a generic url, e.g., no version numbers;
# - have a unique file name (e.g., manual identifier), i.e., be related to the
#   package name.  Things like "refman" or "tutorial" don't work.
# - follow the naming convention for nodes described at
# http://www.gnu.org/software/texinfo/manual/texinfo/html_node/HTML-Xref.html
#   This is what makeinfo and texi2html implement.
#
# Unless the above criteria are met, it's not possible to generate
# reliable cross-manual references.
#
# For information on automatically generating all the useful formats for
# a manual to put on the web, see
# http://www.gnu.org/prep/maintain/html_node/Manuals-on-Web-Pages.html.

# For people editing this file: when a manual named foo is related to a
# package named bar, the url should contain a variable reference ${BAR}.
# Otherwise, the gnumaint scripts have no way of knowing they are
# associated, and thus gnu.org/manual can't include them.

# shorten references to manuals on www.gnu.org.
G = https://www.gnu.org
GS = ${G}/software

3dldf		mono	${GS}/3dldf/manual/user_ref/3DLDF.html
3dldf		node	${GS}/3dldf/manual/user_ref/

alive		mono	${GS}/alive/manual/alive.html
alive		node	${GS}/alive/manual/html_node/

anubis		chapter	${GS}/anubis/manual/html_chapter/
anubis		section	${GS}/anubis/manual/html_section/
anubis		node	${GS}/anubis/manual/html_node/

artanis		mono	${GS}/artanis/manual/artanis.html
artanis		node	${GS}/artanis/manual/html_node/

aspell		section	http://aspell.net/man-html/index.html

auctex		mono	${GS}/auctex/manual/auctex.html
auctex		node	${GS}/auctex/manual/auctex/

autoconf	mono	${GS}/autoconf/manual/autoconf.html
autoconf	node	${GS}/autoconf/manual/html_node/

autogen		mono	${GS}/autogen/manual/html_mono/autogen.html
autogen		chapter	${GS}/autogen/manual/html_chapter/
autogen		node	${GS}/autoconf/manual/html_node/

automake	mono	${GS}/automake/manual/automake.html
automake	node	${GS}/automake/manual/html_node/

avl		node	http://adtinfo.org/libavl.html/

bash		mono	${GS}/bash/manual/bash.html
bash		node	${GS}/bash/manual/html_node/

BINUTILS = https://sourceware.org/binutils/docs
binutils	node	${BINUTILS}/binutils/
 as		node	${BINUTILS}/as/
 bfd		node	${BINUTILS}/bfd/
 gprof		node	${BINUTILS}/gprof/
 ld		node	${BINUTILS}/ld/

bison		mono	${GS}/bison/manual/bison.html
bison		node	${GS}/bison/manual/html_node/

bpel2owfn	mono	${GS}/bpel2owfn/manual/2.0.x/bpel2owfn.html

ccd2cue		mono	${GS}/ccd2cue/manual/ccd2cue.html
ccd2cue		node	${GS}/ccd2cue/manual/html_node/

cflow		mono	${GS}/cflow/manual/cflow.html
cflow		node	${GS}/cflow/manual/html_node/

chess		mono	${GS}/chess/manual/gnuchess.html
chess		node	${GS}/chess/manual/html_node/

combine		mono	${GS}/combine/manual/combine.html
combine		chapter	${GS}/combine/manual/html_chapter/
combine		section	${GS}/combine/manual/html_section/
combine		node	${GS}/combine/manual/html_node/

complexity	mono	${GS}/complexity/manual/complexity.html
complexity	node	${GS}/complexity/manual/html_node/

coreutils	mono	${GS}/coreutils/manual/coreutils
coreutils	node	${GS}/coreutils/manual/html_node/

cpio		mono	${GS}/cpio/manual/cpio
cpio		node	${GS}/cpio/manual/html_node/

cssc		node	${GS}/cssc/manual/

CUIRASS = ${GS}/guix/cuirass/manual
 cuirass	mono	${CUIRASS}/cuirass.html
 cuirass	node	${CUIRASS}/html_node/

CVS = ${GS}/trans-coord/manual
cvs            mono    ${CVS}/cvs/cvs.html
cvs            node    ${CVS}/cvs/html_node/

ddd		mono	${GS}/ddd/manual/html_mono/ddd.html

ddrescue	mono	${GS}/ddrescue/manual/ddrescue_manual.html

dejagnu         node    ${GS}/dejagnu/manual/

DICO = https://puszcza.gnu.org.ua/software/dico/manual
dico		mono	${DICO}/dico.html
dico		chapter	${DICO}/html_chapter/
dico		section	${DICO}/html_section/
dico		node	${DICO}/html_node/

diffutils	mono	${GS}/diffutils/manual/diffutils
diffutils	node	${GS}/diffutils/manual/html_node/

dmd		mono	${GS}/dmd/manual/dmd
dmd		node	${GS}/dmd/manual/html_node/

ed		mono	${GS}/ed/manual/ed_manual.html

EMACS = ${GS}/emacs/manual
emacs		mono	${EMACS}/html_mono/emacs.html
emacs		node	${EMACS}/html_node/emacs/
 #
 ada-mode	mono	${EMACS}/html_mono/ada-mode.html
 ada-mode	node	${EMACS}/html_node/ada-mode/
 #
 autotype	mono	${EMACS}/html_mono/autotype.html
 autotype	node	${EMACS}/html_node/autotype/
 #
 ccmode		mono	${EMACS}/html_mono/ccmode.html
 ccmode		node	${EMACS}/html_node/ccmode/
 #
 cl		mono	${EMACS}/html_mono/cl.html
 cl		node	${EMACS}/html_node/cl/
 #
 ebrowse	mono	${EMACS}/html_mono/ebrowse.html
 ebrowse	node	${EMACS}/html_node/ebrowse/
 #
 ediff		mono	${EMACS}/html_mono/ediff.html
 ediff		node	${EMACS}/html_node/ediff/
 #
 eieio		mono	${EMACS}/html_mono/eieio.html
 eieio		node	${EMACS}/html_node/eieio/
 #
 elisp		mono	${EMACS}/html_mono/elisp.html
 elisp		node	${EMACS}/html_node/elisp/
 #
 epa		mono	${EMACS}/html_mono/epa.html
 epa		node	${EMACS}/html_node/epa/
 #
 erc		mono	${EMACS}/html_mono/erc.html
 erc		node	${EMACS}/html_node/erc/
 #
 dired-x	mono	${EMACS}/html_mono/dired-x.html
 dired-x	node	${EMACS}/html_node/dired-x/
 #
 eshell		mono	${EMACS}/html_mono/eshell.html
 eshell		node	${EMACS}/html_node/eshell/
 #
 eww		mono	${EMACS}/html_mono/eww.html
 eww		node	${EMACS}/html_node/eww/
 #
 flymake	mono	${EMACS}/html_mono/flymake.html
 flymake	node	${EMACS}/html_node/flymake/
 #
 gnus		mono	${EMACS}/html_mono/gnus.html
 gnus		node	${EMACS}/html_node/gnus/
 #
 idlwave	mono	${EMACS}/html_mono/idlwave.html
 idlwave	node	${EMACS}/html_node/idlwave/
 #
 info   	mono	${EMACS}/html_mono/info.html
 info   	node	${EMACS}/html_node/info/
 #
 message	mono	${EMACS}/html_mono/message.html
 message	node	${EMACS}/html_node/message/
 #
 mh-e		mono	${EMACS}/html_mono/mh-e.html
 mh-e		node	${EMACS}/html_node/mh-e/
 #
 nxml-mode	mono	${EMACS}/html_mono/nxml-mode.html
 nxml-mode	node	${EMACS}/html_node/nxml-mode/
 #
 org		mono	${EMACS}/html_mono/org.html
 org		node	${EMACS}/html_node/org/
 #
 pcl-cvs	mono	${EMACS}/html_mono/pcl-cvs.html
 pcl-cvs	node	${EMACS}/html_node/pcl-cvs/
 #
 rcirc		mono	${EMACS}/html_mono/rcirc.html
 rcirc		node	${EMACS}/html_node/rcirc/
 #
 semantic	mono	${EMACS}/html_mono/semantic.html
 semantic	node	${EMACS}/html_node/semantic/
 #
 smtp		mono	${EMACS}/html_mono/smtpmail.html
 smtp		node	${EMACS}/html_node/smtpmail/
 #
 speedbar	mono	${EMACS}/html_mono/speedbar.html
 speedbar	node	${EMACS}/html_node/speedbar/
 #
 tramp		mono	${EMACS}/html_mono/tramp.html
 tramp		node	${EMACS}/html_node/tramp/
 #
 vip		mono	${EMACS}/html_mono/vip.html
 vip		node	${EMACS}/html_node/vip/
 #
 viper		mono	${EMACS}/html_mono/viper.html
 viper		node	${EMACS}/html_node/viper/
 #
 woman		mono	${EMACS}/html_mono/woman.html
 woman		node	${EMACS}/html_node/woman/
 # (end emacs manuals)

easejs		mono	${GS}/easejs/manual/easejs.html
easejs		node	${GS}/easejs/manual/

EMACS_GUIX = https://emacs-guix.gitlab.io/website/manual/latest
emacs-guix	mono	${EMACS_GUIX}/emacs-guix.html
emacs-guix	node	${EMACS_GUIX}/html_node/

emacs-muse	node	${GS}/emacs-muse/manual/muse.html
emacs-muse	node	${GS}/emacs-muse/manual/html_node/

emms		node	${GS}/emms/manual/

# The file is called 'find.info' but the package is 'findutils'.
find		mono	${GS}/findutils/manual/html_mono/find.html
find		node	${GS}/findutils/manual/html_node/find_html
findutils	mono	${GS}/findutils/manual/html_mono/find.html
findutils	node	${GS}/findutils/manual/html_node/find_html

flex		node	https://westes.github.io/flex/manual/

gama		mono	${GS}/gama/manual/gama.html
gama		node	${GS}/gama/manual/html_node/

GAWK = ${GS}/gawk/manual
gawk		mono	${GAWK}/gawk.html
gawk		node	${GAWK}/html_node/
 gawkinet	mono	${GAWK}/gawkinet/gawkinet.html
 gawkinet	node	${GAWK}/gawkinet/html_node/

gcal		mono	${GS}/gcal/manual/gcal.html
gcal		node	${GS}/gcal/manual/html_node/

GCC = https://gcc.gnu.org/onlinedocs
gcc		node	${GCC}/gcc/
 cpp		node	${GCC}/cpp/
 gcj		node	${GCC}/gcj/
 gfortran	node	${GCC}/gfortran/
 gnat_rm	node	${GCC}/gnat_rm/
 gnat_ugn	node	${GCC}/gnat_ugn/
 libgomp	node	${GCC}/libgomp/
 libstdc++	node	${GCC}/libstdc++/
 #
 gccint		node	${GCC}/gccint/
 cppinternals	node	${GCC}/cppinternals/
 gfc-internals	node	${GCC}/gfc-internals/
 gnat-style	node	${GCC}/gnat-style/
 libiberty	node	${GCC}/libiberty/

GDB = https://sourceware.org/gdb/current/onlinedocs
gdb		node	${GDB}/gdb/
 stabs		node	${GDB}/stabs/

GDBM = http://www.gnu.org.ua/software/gdbm/manual
gdbm		mono	${GDBM}/gdbm.html
gdbm		chapter	${GDBM}/html_chapter/
gdbm		section ${GDBM}/html_section/
gdbm		node	${GDBM}/html_node/

geiser		chapter	http://geiser.nongnu.org/

gettext		mono	${GS}/gettext/manual/gettext.html
gettext		node	${GS}/gettext/manual/html_node/

gforth		node	https://www.complang.tuwien.ac.at/forth/gforth/Docs-html/

# Also found at:
# https://mirrors.edge.kernel.org/pub/software/scm/git/docs/user-manual.html
# https://git.github.io/htmldocs/user-manual.html
git		mono	https://git-scm.com/docs/user-manual

global		mono	${GS}/global/manual/global.html

gmediaserver	node	${GS}/gmediaserver/manual/

gmp		node	https://www.gmplib.org/manual/

gnu-arch	node	${GS}/gnu-arch/tutorial/

gnu-c-manual	mono	${GS}/gnu-c-manual/gnu-c-manual.html

gnu-crypto	node	${GS}/gnu-crypto/manual/

gnubg		mono	${GS}/gnubg/manual/gnubg.html
gnubg		node	${GS}/gnubg/manual/html_node/

gnubik		mono	${GS}/gnubik/manual/gnubik.html
gnubik		node	${GS}/gnubik/manual/html_node/

gnulib		mono	${GS}/gnulib/manual/gnulib.html
gnulib		node	${GS}/gnulib/manual/html_node/

GNUN = ${GS}/trans-coord/manual
gnun		mono	${GNUN}/gnun/gnun.html
gnun		node	${GNUN}/gnun/html_node/
 web-trans	mono	${GNUN}/web-trans/web-trans.html
 web-trans	node	${GNUN}/web-trans/html_node/

GNUPG = https://www.gnupg.org/documentation/manuals
gnupg		node	${GNUPG}/gnupg/
 dirmngr	node	${GNUPG}/dirmngr/
 gcrypt		node	${GNUPG}/gcrypt/
 libgcrypt	node	${GNUPG}/gcrypt/
 ksba		node	${GNUPG}/ksba/
 assuan		node	${GNUPG}/assuan/
 gpgme		node	${GNUPG}/gpgme/

gnuprologjava	node	${GS}/gnuprologjava/manual/

gnuschool	mono	${GS}/gnuschool/gnuschool.html

GNUSTANDARDS = ${G}/prep
 maintain	mono	${GNUSTANDARDS}/maintain/maintain.html
 maintain	node	${GNUSTANDARDS}/maintain/html_node/
 #
 standards	mono	${GNUSTANDARDS}/standards/standards.html
 standards	node	${GNUSTANDARDS}/standards/html_node/

gnutls		mono	${GS}/gnutls/manual/gnutls.html
gnutls		node	${GS}/gnutls/manual/html_node/

gnutls-guile	mono	http://gnutls.org/manual/gnutls-guile.html
gnutls-guile	node	http://gnutls.org/manual/gnutls-guile/

gperf		mono	${GS}/gperf/manual/gperf.html
gperf		node	${GS}/gperf/manual/html_node/

grep		mono	${GS}/grep/manual/grep.html
grep		node	${GS}/grep/manual/html_node/

groff		node	${GS}/groff/manual/html_node/

GRUB = ${GS}/grub/manual
  grub		mono	${GRUB}/grub.html
  grub		node	${GRUB}/html_node/
  #
  multiboot	mono	${GRUB}/multiboot/multiboot.html
  multiboot	node	${GRUB}/multiboot/html_node/

gsasl		mono	${GS}/gsasl/manual/gsasl.html
gsasl		node	${GS}/gsasl/manual/html_node/

gsl		node	${GS}/gsl/manual/html_node/

gsrc		mono	${GS}/gsrc/manual/gsrc.html
gsrc		node	${GS}/gsrc/manual/html_node/

gss		mono	${GS}/gss/manual/gss.html
gss		node	${GS}/gss/manual/html_node/

gtypist		mono	${GS}/gtypist/doc/

guile		mono	${GS}/guile/manual/guile.html
guile		node	${GS}/guile/manual/html_node/

guile-avahi	mono	http://nongnu.org/guile-avahi/doc/guile-avahi.html

GUILE_GNOME = ${GS}/guile-gnome/docs
 gobject 	node	${GUILE_GNOME}/gobject/html/
 glib		node	${GUILE_GNOME}/glib/html/
 atk		node	${GUILE_GNOME}/atk/html/
 pango		node	${GUILE_GNOME}/pango/html/
 pangocairo	node	${GUILE_GNOME}/pangocairo/html/
 gdk		node	${GUILE_GNOME}/gdk/html/
 gtk		node	${GUILE_GNOME}/gtk/html/
 libglade	node	${GUILE_GNOME}/libglade/html/
 gnome-vfs	node	${GUILE_GNOME}/gnome-vfs/html/
 libgnomecanvas	node	${GUILE_GNOME}/libgnomecanvas/html/
 gconf		node	${GUILE_GNOME}/gconf/html/
 libgnome	node	${GUILE_GNOME}/libgnome/html/
 libgnomeui	node	${GUILE_GNOME}/libgnomeui/html/
 corba		node	${GUILE_GNOME}/corba/html/
 clutter	node	${GUILE_GNOME}/clutter/html/
 clutter-glx	node	${GUILE_GNOME}/clutter-glx/html/

guile-gtk	node	${GS}/guile-gtk/docs/guile-gtk/

guile-netlink	mono	https://git.lepiller.eu/guile-netlink/manual/manual.html

guile-rpc	mono	${GS}/guile-rpc/manual/guile-rpc.html
guile-rpc	node	${GS}/guile-rpc/manual/html_node/

GUIX_ROOT = https://guix.gnu.org
GUIX = ${GUIX_ROOT}/manual
 guix.de	mono	${GUIX}/de/guix.de.html
 guix.de	node	${GUIX}/de/html_node/
 guix.es	mono	${GUIX}/es/guix.es.html
 guix.es	node	${GUIX}/es/html_node/
 guix.fr	mono	${GUIX}/fr/guix.fr.html
 guix.fr	node	${GUIX}/fr/html_node/
 guix.pt_BR	mono	${GUIX}/pt-br/guix.pt_BR.html
 guix.pt_BR	node	${GUIX}/pt-br/html_node/
 guix.ru	mono	${GUIX}/ru/guix.ru.html
 guix.ru	node	${GUIX}/ru/html_node/
 guix.zh_CN	mono	${GUIX}/zh-cn/guix.zh_CN.html
 guix.zh_CN	node	${GUIX}/zh-cn/html_node/
 guix		mono	${GUIX}/en/guix.html
 guix		node	${GUIX}/en/html_node/

GUIX_COOKBOOK = ${GUIX_ROOT}/cookbook
 guix-cookbook.de	mono	${GUIX_COOKBOOK}/de/guix-cookbook.de.html
 guix-cookbook.de	node    ${GUIX_COOKBOOK}/de/html_node/
 guix-cookbook.fr	mono    ${GUIX_COOKBOOK}/fr/guix-cookbook.fr.html
 guix-cookbook.fr	node    ${GUIX_COOKBOOK}/fr/html_node/
 guix-cookbook.ko	mono    ${GUIX_COOKBOOK}/ko/guix-cookbook.ko.html
 guix-cookbook.ko	node    ${GUIX_COOKBOOK}/ko/html_node/
 guix-cookbook.pt_BR	mono    ${GUIX_COOKBOOK}/pt-br/guix-cookbook.pt_BR.html
 guix-cookbook.pt_BR	node    ${GUIX_COOKBOOK}/pt-br/html_node/
 guix-cookbook.sk	mono    ${GUIX_COOKBOOK}/sk/guix-cookbook.sk.html
 guix-cookbook.sk	node    ${GUIX_COOKBOOK}/sk/html_node/
 guix-cookbook.sv	mono    ${GUIX_COOKBOOK}/sv/guix-cookbook.sv.html
 guix-cookbook.sv	node    ${GUIX_COOKBOOK}/sv/html_node/
 guix-cookbook		mono    ${GUIX_COOKBOOK}/en/guix-cookbook.html
 guix-cookbook		node	${GUIX_COOKBOOK}/en/html_node/

gv		mono	${GS}/gv/manual/gv.html
gv		node	${GS}/gv/manual/html_node/

gzip		mono	${GS}/gzip/manual/gzip.html
gzip		node	${GS}/gzip/manual/html_node/

hello		mono	${GS}/hello/manual/hello.html
hello		node	${GS}/hello/manual/html_node/

help2man	mono	${GS}/help2man/help2man.html

# XXX: These are actually pages created by texi2html, so no quite following
# the expected naming scheme.
hurd		mono	${GS}/hurd/doc/

idutils		mono	${GS}/idutils/manual/idutils.html
idutils		node	${GS}/idutils/manual/html_node/

inetutils	mono	${GS}/inetutils/manual/inetutils.html
inetutils	node	${GS}/inetutils/manual/html_node/

jwhois		mono	${GS}/jwhois/manual/jwhois.html
jwhois		node	${GS}/jwhois/manual/html_node/

libc		mono	${GS}/libc/manual/html_mono/libc.html
libc		node	${GS}/libc/manual/html_node/

LIBCDIO = ${GS}/libcdio
 libcdio	mono	${LIBCDIO}/libcdio.html
 cd-text	mono	${LIBCDIO}/cd-text-format.html

libextractor	mono	${GS}/libextractor/manual/libextractor.html
libextractor	node	${GS}/libextractor/manual/html_node/

libidn		mono	${GS}/libidn/manual/libidn.html
libidn		node	${GS}/libidn/manual/html_node/

librejs		mono	${GS}/librejs/manual/librejs.html
librejs		node	${GS}/librejs/manual/html_node/

libmatheval	mono	${GS}/libmatheval/manual/libmatheval.html

LIBMICROHTTPD = ${GS}/libmicrohttpd
libmicrohttpd		mono	${LIBMICROHTTPD}/manual/libmicrohttpd.html
libmicrohttpd		node	${LIBMICROHTTPD}/manual/html_node/
 microhttpd-tutorial	mono	${LIBMICROHTTPD}/tutorial.html

libtasn1	mono	${GS}/libtasn1/manual/libtasn1.html
libtasn1	node	${GS}/libtasn1/manual/html_node/

libtool		mono	${GS}/libtool/manual/libtool.html
libtool		node	${GS}/libtool/manual/html_node/

lightning	mono	${GS}/lightning/manual/lightning.html
lightning	node	${GS}/lightning/manual/html_node/

# The stable/ url redirects immediately, but that's ok.
# The .html extension is omitted on their web site, but it works if given.
LILYPOND = http://lilypond.org/doc/stable/Documentation
 lilypond-internals	node ${LILYPOND}/internals/
 lilypond-learning	node ${LILYPOND}/learning/
 lilypond-notation 	node ${LILYPOND}/notation/
 lilypond-snippets 	node ${LILYPOND}/snippets/
 lilypond-usage		node ${LILYPOND}/usage/
 lilypond-web		node ${LILYPOND}/web/
 music-glossary		node ${LILYPOND}/music-glossary/

liquidwar6	mono	${GS}/liquidwar6/manual/liquidwar6.html
liquidwar6	node	${GS}/liquidwar6/manual/html_node/

lispintro	mono	${GS}/emacs/emacs-lisp-intro/html_mono/emacs-lisp-intro.html
lispintro	node	${GS}/emacs/emacs-lisp-intro/html_node/index.html

LSH = http://www.lysator.liu.se/~nisse/lsh
  lsh		mono	${LSH}/lsh.html

m4		mono	${GS}/m4/manual/m4.html
m4		node	${GS}/m4/manual/html_node/

mailutils	mono	${GS}/mailutils/manual/mailutils.html
mailutils	chapter	${GS}/mailutils/manual/html_chapter/
mailutils	section	${GS}/mailutils/manual/html_section/
mailutils	node	${GS}/mailutils/manual/html_node/

make		mono	${GS}/make/manual/make.html
make		node	${GS}/make/manual/html_node/

mcron		mono	${GS}/mcron/manual/mcron.html
mcron		node	${GS}/mcron/manual/html_node/

mdk		mono	${GS}/mdk/manual/mdk.html
mdk		node	${GS}/mdk/manual/html_node/

METAEXCHANGE = https://ftp.gwdg.de/pub/gnu2/iwfmdh/doc/texinfo
 iwf_mh		node	${METAEXCHANGE}/iwf_mh.html
 scantest	node	${METAEXCHANGE}/scantest.html

mes		mono	${GS}/mes/manual/mes.html
mes		node	${GS}/mes/manual/html_node/

MIT_SCHEME = ${GS}/mit-scheme/documentation/stable
 mit-scheme-ref	  mono	${MIT_SCHEME}/mit-scheme-ref.html
 mit-scheme-ref	  node	${MIT_SCHEME}/mit-scheme-ref/
 mit-scheme-user  mono	${MIT_SCHEME}/mit-scheme-user.html
 mit-scheme-user  node	${MIT_SCHEME}/mit-scheme-user/
 sos		  mono	${MIT_SCHEME}/mit-scheme-sos.html
 sos		  node	${MIT_SCHEME}/mit-scheme-sos/
 mit-scheme-imail mono	${MIT_SCHEME}/mit-scheme-imail.html

moe		mono	${GS}/moe/manual/moe_manual.html

motti		node	${GS}/motti/manual/

mpc		node	http://www.multiprecision.org/index.php?prog=mpc&page=html

mpfr		mono	http://www.mpfr.org/mpfr-current/mpfr.html

mtools		mono	${GS}/mtools/manual/mtools.html

myserver	mono	http://www.myserverproject.net/doc.php

nano		mono	https://www.nano-editor.org/dist/latest/nano.html

nettle		chapter	http://www.lysator.liu.se/~nisse/nettle/nettle.html

ocrad		mono	${GS}/ocrad/manual/ocrad_manual.html

parted		mono	${GS}/parted/manual/parted.html
parted		node	${GS}/parted/manual/html_node/

pascal		mono	http://www.gnu-pascal.de/gpc/

# can't use pcb since url's contain dates --30nov10

perl		mono	${GS}/perl/manual/perldoc-all.html

PIES = http://www.gnu.org.ua/software/pies/manual
pies		mono	${PIES}/pies.html
pies 		chapter	${PIES}/html_chapter/
pies 		section	${PIES}/html_section/
pies		node	${PIES}/html_node/

plotutils	mono	${GS}/plotutils/manual/en/plotutils.html
plotutils	node	${GS}/plotutils/manual/en/html_node/

proxyknife	mono	${GS}/proxyknife/manual/proxyknife.html
proxyknife	node	${GS}/proxyknife/manual/html_node/

pspp		mono	${GS}/pspp/manual/pspp.html
pspp		node	${GS}/pspp/manual/html_node/

pyconfigure	mono	${GS}/pyconfigure/manual/pyconfigure.html
pyconfigure	node	${GS}/pyconfigure/manual/html_node/

R = https://cran.r-project.org/doc/manuals
 R-intro	mono	${R}/R-intro.html
 R-lang		mono	${R}/R-lang.html
 R-exts		mono	${R}/R-exts.html
 R-data		mono	${R}/R-data.html
 R-admin	mono	${R}/R-admin.html
 R-ints		mono	${R}/R-ints.html

rcs		mono	${GS}/rcs/manual/rcs.html
rcs		node	${GS}/rcs/manual/html_node/

READLINE = https://tiswww.cwru.edu/php/chet/readline
readline        mono    ${READLINE}/readline.html
 rluserman      mono    ${READLINE}/rluserman.html
 history        mono    ${READLINE}/history.html

recode		mono	http://recode.progiciels-bpi.ca/manual/index.html

recutils	mono	${GS}/recutils/manual/recutils.html
recutils	node	${GS}/recutils/manual/html_node/

reftex		mono	${GS}/auctex/manual/reftex.html
reftex		node	${GS}/auctex/manual/reftex/

remotecontrol	mono	${GS}/remotecontrol/manual/remotecontrol.html
remotecontrol	node	${GS}/remotecontrol/manual/html_node/

rottlog		mono	${GS}/rottlog/manual/rottlog.html
rottlog		node	${GS}/rottlog/manual/html_node/

RUSH = http://www.gnu.org.ua/software/rush/manual
rush		mono	${RUSH}/rush.html
rush 		chapter	${RUSH}/html_chapter/
rush 		section	${RUSH}/html_section/
rush		node	${RUSH}/html_node/

screen		mono	${GS}/screen/manual/screen.html
screen		node	${GS}/screen/manual/html_node/

sed		mono	${GS}/sed/manual/sed.html
sed		node	${GS}/sed/manual/html_node/

sharutils	mono	${GS}/sharutils/manual/html_mono/sharutils.html
sharutils	chapter	${GS}/sharutils/manual/html_chapter/
sharutils	node	${GS}/sharutils/manual/html_node/

shepherd	mono	${GS}/shepherd/manual/shepherd.html
shepherd	node	${GS}/shepherd/manual/html_node/

# can't use mono files since they have generic names
SMALLTALK = ${GS}/smalltalk
smalltalk	node	${SMALLTALK}/manual/html_node/
 smalltalk-base	node	${SMALLTALK}/manual-base/html_node/
 smalltalk-libs	node	${SMALLTALK}/manual-libs/html_node/

sourceinstall	mono	${GS}/sourceinstall/manual/sourceinstall.html
sourceinstall	node	${GS}/sourceinstall/manual/html_node/

sqltutor	mono	${GS}/sqltutor/manual/sqltutor.html
sqltutor	node	${GS}/sqltutor/manual/html_node/

src-highlite	mono	${GS}/src-highlite/source-highlight.html

stow		mono	${GS}/stow/manual/stow.html
stow		node	${GS}/stow/manual/html_node/

swbis		mono	${GS}/swbis/manual.html

tar		mono	${GS}/tar/manual/tar.html
tar		chapter	${GS}/tar/manual/html_chapter/
tar		section	${GS}/tar/manual/html_section/
tar		node	${GS}/tar/manual/html_node/

teseq		mono	${GS}/teseq/teseq.html
teseq		node	${GS}/teseq/html_node/

TEXINFO = ${GS}/texinfo/manual
texinfo		mono	${TEXINFO}/texinfo/texinfo.html
texinfo		node	${TEXINFO}/texinfo/html_node/
 #
 info-stnd	mono	${TEXINFO}/info-stnd/info-stnd.html
 info-stnd	node	${TEXINFO}/info-stnd/html_node/

thales		node	${GS}/thales/manual/

units		mono	${GS}/units/manual/units.html
units		node	${GS}/units/manual/html_node/

vc-dwim		mono	${GS}/vc-dwim/manual/vc-dwim.html
vc-dwim		node	${GS}/vc-dwim/manual/html_node/

wdiff		mono	${GS}/wdiff/manual/wdiff.html
wdiff		node	${GS}/wdiff/manual/html_node/

websocket4j	mono	${GS}/websocket4j/manual/websocket4j.html
websocket4j	node	${GS}/websocket4j/manual/html_node/

wget		mono	${GS}/wget/manual/wget.html
wget		node	${GS}/wget/manual/html_node/

xboard		mono	${GS}/xboard/manual/xboard.html
xboard		node	${GS}/xboard/manual/html_node/

# emacs-page
# Free TeX-related Texinfo manuals on tug.org.

T = https://tug.org/texinfohtml

dvipng		mono	${T}/dvipng.html
dvips		mono	${T}/dvips.html
eplain		mono	${T}/eplain.html
kpathsea	mono	${T}/kpathsea.html
latex2e		mono	${T}/latex2e.html
tlbuild		mono	${T}/tlbuild.html
web2c		mono	${T}/web2c.html

ELPA     = https://elpa.gnu.org
ELPA_DOC = ${ELPA}/packages/doc

debbugs-ug	mono	${ELPA_DOC}/debbugs-ug.html


# Local Variables:
# eval: (add-hook 'write-file-functions 'time-stamp)
# time-stamp-start: "htmlxrefversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:
id='n691' href='#n691'>691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
;;;
;;; 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/>.

(define-module (gnu bootloader grub)
  #:use-module (guix build union)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix gexp)
  #:use-module (gnu artwork)
  #:use-module (gnu bootloader)
  #:use-module (gnu system uuid)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system keyboard)
  #:use-module (gnu system locale)
  #:use-module (gnu packages bootloaders)
  #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
  #:autoload   (gnu packages xorg) (xkeyboard-config)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-2)
  #:export (grub-theme
            grub-theme?
            grub-theme-image
            grub-theme-resolution
            grub-theme-color-normal
            grub-theme-color-highlight
            grub-theme-gfxmode

            install-grub-efi-netboot

            grub-bootloader
            grub-efi-bootloader
            grub-efi-netboot-bootloader
            grub-mkrescue-bootloader
            grub-minimal-bootloader

            grub-configuration))

;;; Commentary:
;;;
;;; Configuration of GNU GRUB.
;;;
;;; Code:

(define* (normalize-file file mount-point store-directory-prefix)
  "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
G-expression or other lowerable object denoting a file name."

  (define (strip-mount-point mount-point file)
    (if mount-point
        (if (string=? mount-point "/")
            file
            #~(let ((file #$file))
                (if (string-prefix? #$mount-point file)
                    (substring #$file #$(string-length mount-point))
                    file)))
        file))

  (define (prepend-store-directory-prefix store-directory-prefix file)
    (if store-directory-prefix
        #~(string-append #$store-directory-prefix #$file)
        file))

  (prepend-store-directory-prefix store-directory-prefix
                                  (strip-mount-point mount-point file)))



(define-record-type* <grub-theme>
  ;; Default theme contributed by Felipe López.
  grub-theme make-grub-theme
  grub-theme?
  (image           grub-theme-image
                   (default (file-append %artwork-repository
                                         "/grub/GuixSD-fully-black-4-3.svg")))
  (resolution      grub-theme-resolution
                   (default '(1024 . 768)))
  (color-normal    grub-theme-color-normal
                   (default '((fg . light-gray) (bg . black))))
  (color-highlight grub-theme-color-highlight
                   (default '((fg . yellow) (bg . black))))
  (gfxmode         grub-theme-gfxmode
                   (default '("auto"))))          ;list of string


;;;
;;; Background image & themes.
;;;

(define (bootloader-theme config)
  "Return user defined theme in CONFIG if defined or a default theme
otherwise."
  (or (bootloader-configuration-theme config) (grub-theme)))

(define* (image->png image #:key width height)
  "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
Otherwise the picture in IMAGE is just copied."
  (computed-file "grub-image.png"
                 (with-imported-modules '((gnu build svg))
                   (with-extensions (list guile-rsvg guile-cairo)
                     #~(if (string-suffix? ".svg" #+image)
                           (begin
                             (use-modules (gnu build svg))
                             (svg->png #+image #$output
                                       #:width #$width
                                       #:height #$height))
                           (copy-file #+image #$output))))))

(define* (grub-background-image config)
  "Return the GRUB background image defined in CONFIG or #f if none was found.
If the suffix of the image file is \".svg\", then it is converted into a PNG
file with the resolution provided in CONFIG."
  (let* ((theme (bootloader-theme config))
         (image (grub-theme-image theme)))
    (and image
         (match (grub-theme-resolution theme)
           (((? number? width) . (? number? height))
            (image->png image #:width width #:height height))
           (_ #f)))))

(define (grub-locale-directory grub)
  "Generate a directory with the locales from GRUB."
  (define builder
    #~(begin
        (use-modules (ice-9 ftw))
        (let ((locale (string-append #$grub "/share/locale"))
              (out    #$output))
          (mkdir out)
          (chdir out)
          (for-each (lambda (lang)
                      (let ((file (string-append locale "/" lang
                                                 "/LC_MESSAGES/grub.mo"))
                            (dest (string-append lang ".mo")))
                        (when (file-exists? file)
                          (copy-file file dest))))
                    (scandir locale)))))
  (computed-file "grub-locales" builder))

(define* (eye-candy config store-device store-mount-point
                    #:key store-directory-prefix port)
  "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
concerned with graphics mode, background images, colors, and all that.
STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
its mount point; these are used to determine where the background image and
fonts must be searched for.  STORE-DIRECTORY-PREFIX is a directory prefix to
prepend to any store file name."
  (define (setup-gfxterm config font-file)
    (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
        #~(format #f "
if loadfont ~a; then
  set gfxmode=~a
  insmod all_video
  insmod gfxterm
fi~%"
                  #+font-file
                  #$(string-join
                     (grub-theme-gfxmode (bootloader-theme config))
                     ";"))
        ""))

  (define (theme-colors type)
    (let* ((theme  (bootloader-theme config))
           (colors (type theme)))
      (string-append (symbol->string (assoc-ref colors 'fg)) "/"
                     (symbol->string (assoc-ref colors 'bg)))))

  (define font-file
    (let* ((bootloader (bootloader-configuration-bootloader config))
           (grub (bootloader-package bootloader)))
      (normalize-file (file-append grub "/share/grub/unicode.pf2")
                      store-mount-point
                      store-directory-prefix)))

  (define image
    (normalize-file (grub-background-image config)
                    store-mount-point
                    store-directory-prefix))

  (and image
       #~(format #$port "
# Set 'root' to the partition that contains /gnu/store.
~a

~a
~a

insmod png
if background_image ~a; then
  set color_normal=~a
  set color_highlight=~a
else
  set menu_color_normal=cyan/blue
  set menu_color_highlight=white/blue
fi~%"
                 #$(grub-root-search store-device font-file)
                 #$(setup-gfxterm config font-file)
                 #$(grub-setup-io config)

                 #$image
                 #$(theme-colors grub-theme-color-normal)
                 #$(theme-colors grub-theme-color-highlight))))


;;;
;;; Configuration file.
;;;

(define* (keyboard-layout-file layout
                               #:key
                               (grub grub))
  "Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
and return a file in the format for GRUB keymaps.  LAYOUT must be present in
the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
  (define builder
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils))

          ;; 'grub-kbdcomp' passes all its arguments but '-o' to 'ckbcomp'
          ;; (from the 'console-setup' package).
          (invoke #+(file-append grub "/bin/grub-mklayout")
                  "-i" #+(keyboard-layout->console-keymap layout)
                  "-o" #$output))))

  (computed-file (string-append "grub-keymap."
                                (string-map (match-lambda
                                              (#\, #\-)
                                              (chr chr))
                                            (keyboard-layout-name layout)))
                 builder))

(define (grub-setup-io config)
  "Return GRUB commands to configure the input / output interfaces.  The result
is a string that can be inserted in grub.cfg."
  (let* ((symbols->string (lambda (list)
                           (string-join (map symbol->string list) " ")))
         (outputs (bootloader-configuration-terminal-outputs config))
         (inputs (bootloader-configuration-terminal-inputs config))
         (unit (bootloader-configuration-serial-unit config))
         (speed (bootloader-configuration-serial-speed config))

         ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
         ;; as documented in GRUB manual section "Simple Configuration
         ;; Handling".
         (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
                          gfxterm vga_text mda_text morse spkmodem))
         (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
                         at_keyboard usb_keyboard))

         (io (string-append
               "terminal_output "
               (symbols->string
                 (map
                   (lambda (output)
                     (if (memq output valid-outputs) output #f)) outputs)) "\n"
               (if (null? inputs)
                 ""
                 (string-append
                   "terminal_input "
                   (symbols->string
                     (map
                       (lambda (input)
                         (if (memq input valid-inputs) input #f)) inputs)) "\n"))
               ;; UNIT and SPEED are arguments to the same GRUB command
               ;; ("serial"), so we process them together.
               (if (or unit speed)
                 (string-append
                   "serial"
                   (if unit
                     ;; COM ports 1 through 4
                     (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
                       (string-append " --unit=" (number->string unit))
                       #f)
                     "")
                   (if speed
                     (if (exact-integer? speed)
                       (string-append " --speed=" (number->string speed))
                       #f)
                     ""))
                 ""))))
    (format #f "~a" io)))

(define (grub-root-search device file)
  "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
code."
  ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
  ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
  ;; custom menu entries.  In the latter case, don't emit a 'search' command.
  (if (and (string? file) (not (string-prefix? "/" file)))
      ""
      (match device
        ;; Preferably refer to DEVICE by its UUID or label.  This is more
        ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
        ((? uuid? uuid)
         (format #f "search --fs-uuid --set ~a"
                 (uuid->string device)))
        ((? file-system-label? label)
         (format #f "search --label --set ~a"
                 (file-system-label->string label)))
        ((? (lambda (device)
              (and (string? device) (string-contains device ":/"))) nfs-uri)
         ;; If the device is an NFS share, then we assume that the expected
         ;; file on that device (e.g. the GRUB background image or the kernel)
         ;; has to be loaded over the network.  Otherwise we would need an
         ;; additional device information for some local disk to look for that
         ;; file, which we do not have.
         ;;
         ;; We explicitly set "root=(tftp)" here even though if grub.cfg
         ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
         ;; automatically anyway.  The reason is if you have a system that
         ;; used to be on NFS but now is local, root would be set to local
         ;; disk.  If you then selected an older system generation that is
         ;; supposed to boot from network in the Grub boot menu, Grub still
         ;; wouldn't load those files from network otherwise.
         ;;
         ;; TFTP is preferred to HTTP because it is used more widely and
         ;; specified in standards more widely--especially BOOTP/DHCPv4
         ;; defines a TFTP server for DHCP option 66, but not HTTP.
         ;;
         ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
         ;; which can contain a HTTP or TFTP URL.
         ;;
         ;; Note: It is assumed that the file paths are of a similar
         ;; setup on both the TFTP server and the NFS server (it is
         ;; not possible to search for files on TFTP).
         ;;
         ;; TODO: Allow HTTP.
         "set root=(tftp)")
        ((or #f (? string?))
         #~(format #f "search --file --set ~a" #$file)))))

(define* (grub-configuration-file config entries
                                  #:key
                                  (locale #f)
                                  (system (%current-system))
                                  (old-entries '())
                                  (store-crypto-devices '())
                                  store-directory-prefix)
  "Return the GRUB configuration file corresponding to CONFIG, a
<bootloader-configuration> object, and where the store is available at
STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system.
STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
be unlocked to access the store contents.
STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
when booting a root file system on a Btrfs subvolume."
  (define all-entries
    (append entries (bootloader-configuration-menu-entries config)))
  (define (menu-entry->gexp entry)
    (let ((label (menu-entry-label entry))
          (linux (menu-entry-linux entry))
          (device (menu-entry-device entry))
          (device-mount-point (menu-entry-device-mount-point entry)))
      (if linux
          (let ((arguments (menu-entry-linux-arguments entry))
                (linux (normalize-file linux
                                       device-mount-point
                                       store-directory-prefix))
                (initrd (normalize-file (menu-entry-initrd entry)
                                        device-mount-point
                                        store-directory-prefix)))
         ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
         ;; Use the right file names for LINUX and INITRD in case
         ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
         ;; separate partition.

         ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
         ;; initrd paths, to allow booting from a Btrfs subvolume.
         #~(format port "menuentry ~s {
  ~a
  linux ~a ~a
  initrd ~a
}~%"
                   #$label
                   #$(grub-root-search device linux)
                   #$linux (string-join (list #$@arguments))
                   #$initrd))
          (let ((kernel (menu-entry-multiboot-kernel entry))
                (arguments (menu-entry-multiboot-arguments entry))
                (modules (menu-entry-multiboot-modules entry))
                (root-index 1))            ; XXX EFI will need root-index 2
        #~(format port "
menuentry ~s {
  multiboot ~a root=device:hd0s~a~a~a
}~%"
                  #$label
                  #$kernel
                  #$root-index (string-join (list #$@arguments) " " 'prefix)
                  (string-join (map string-join '#$modules)
                               "\n  module " 'prefix))))))

  (define (crypto-devices)
    (define (crypto-device->cryptomount dev)
      (if (uuid? dev)
          #~(format port "cryptomount -u ~a~%"
                    ;; cryptomount only accepts UUID without the hypen.
                    #$(string-delete #\- (uuid->string dev)))
          ;; Other type of devices aren't implemented.
          #~()))
    (let ((devices (map crypto-device->cryptomount store-crypto-devices))
          ;; XXX: Add luks2 when grub 2.06 is packaged.
          (modules #~(format port "insmod luks~%")))
      (if (null? devices)
          devices
          (cons modules devices))))

  (define (sugar)
    (let* ((entry (first all-entries))
           (device (menu-entry-device entry))
           (mount-point (menu-entry-device-mount-point entry)))
      (eye-candy config
                 device
                 mount-point
                 #:store-directory-prefix store-directory-prefix
                 #:port #~port)))

  (define locale-config
    (let* ((entry (first all-entries))
           (device (menu-entry-device entry))
           (mount-point (menu-entry-device-mount-point entry))
           (bootloader (bootloader-configuration-bootloader config))
           (grub (bootloader-package bootloader)))
      #~(let ((locale #$(and locale
                             (locale-definition-source
                              (locale-name->definition locale))))
              (locales #$(and locale
                              (normalize-file (grub-locale-directory grub)
                                              mount-point
                                              store-directory-prefix))))
          (when locale
            (format port "\
# Localization configuration.
~asearch --file --set ~a/en@quot.mo
set locale_dir=~a
set lang=~a~%"
                    ;; Skip the search if there is an image, as it has already
                    ;; been performed by eye-candy and traversing the store is
                    ;; an expensive operation.
                    #$(if (grub-theme-image (bootloader-theme config))
                          "# "
                          "")
                    locales
                    locales
                    locale)))))

  (define keyboard-layout-config
    (let* ((layout (bootloader-configuration-keyboard-layout config))
           (grub   (bootloader-package
                    (bootloader-configuration-bootloader config)))
           (keymap* (and layout
                         (keyboard-layout-file layout #:grub grub)))
           (entry (first all-entries))
           (device (menu-entry-device entry))
           (mount-point (menu-entry-device-mount-point entry))
           (keymap (and keymap*
                        (normalize-file keymap* mount-point
                                        store-directory-prefix))))
      #~(when #$keymap
          (format port "\
insmod keylayouts
keymap ~a~%" #$keymap))))

  (define builder
    #~(call-with-output-file #$output
        (lambda (port)
          (format port
                  "# This file was generated from your Guix configuration.  Any changes
# will be lost upon reconfiguration.
")
          #$@(crypto-devices)
          #$(sugar)
          #$locale-config
          #$keyboard-layout-config
          (format port "
set default=~a
set timeout=~a~%"
                  #$(bootloader-configuration-default-entry config)
                  #$(bootloader-configuration-timeout config))
          #$@(map menu-entry->gexp all-entries)

          #$@(if (pair? old-entries)
                 #~((format port "
submenu \"GNU system, old configurations...\" {~%")
                    #$@(map menu-entry->gexp old-entries)
                    (format port "}~%"))
                 #~())
          (format port "
if [ \"${grub_platform}\" == efi ]; then
  menuentry \"Firmware setup\" {
    fwsetup
  }
fi~%"))))

  ;; Since this file is rather unique, there's no point in trying to
  ;; substitute it.
  (computed-file "grub.cfg" builder
                 #:options '(#:local-build? #t
                             #:substitutable? #f)))



;;;
;;; Install procedures.
;;;

(define install-grub
  #~(lambda (bootloader device mount-point)
      (let ((grub (string-append bootloader "/sbin/grub-install"))
            (install-dir (string-append mount-point "/boot")))
        ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
        ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
        (if device
            (begin
              ;; Tell 'grub-install' that there might be a LUKS-encrypted
              ;; /boot or root partition.
              (setenv "GRUB_ENABLE_CRYPTODISK" "y")

              ;; Hide potentially confusing messages from the user, such as
              ;; "Installing for i386-pc platform."
              (invoke/quiet grub "--no-floppy" "--target=i386-pc"
                            "--boot-directory" install-dir
                            device))
            ;; When creating a disk-image, only install GRUB modules.
            (copy-recursively (string-append bootloader "/lib/")
                              install-dir)))))

(define install-grub-disk-image
  #~(lambda (bootloader root-index image)
      ;; Install GRUB on the given IMAGE. The root partition index is
      ;; ROOT-INDEX.
      (let ((grub-mkimage
             (string-append bootloader "/bin/grub-mkimage"))
            (modules '("biosdisk" "part_msdos" "fat" "ext2"))
            (grub-bios-setup
             (string-append bootloader "/sbin/grub-bios-setup"))
            (root-device (format #f "hd0,msdos~a" root-index))
            (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
            (device-map "device.map"))

        ;; Create a minimal, standalone GRUB image that will be written
        ;; directly in the MBR-GAP (space between the end of the MBR and the
        ;; first partition).
        (apply invoke grub-mkimage
               "-O" "i386-pc"
               "-o" "core.img"
               "-p" (format #f "(~a)/boot/grub" root-device)
               modules)

        ;; Create a device mapping file.
        (call-with-output-file device-map
          (lambda (port)
            (format port "(hd0) ~a~%" image)))

        ;; Copy the default boot.img, that will be written on the MBR sector
        ;; by GRUB-BIOS-SETUP.
        (copy-file boot-img "boot.img")

        ;; Install both the "boot.img" and the "core.img" files on the given
        ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
        ;; written in the MBR-GAP. GRUB configuration and missing modules will
        ;; be read from ROOT-DEVICE.
        (invoke grub-bios-setup
                "-m" device-map
                "-r" root-device
                "-d" "."
                image))))

(define install-grub-efi
  #~(lambda (bootloader efi-dir mount-point)
      ;; There is nothing useful to do when called in the context of a disk
      ;; image generation.
      (when efi-dir
        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
        ;; system whose root is mounted at MOUNT-POINT.
        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
              (install-dir (string-append mount-point "/boot"))
              ;; When installing Guix, it's common to mount EFI-DIR below
              ;; MOUNT-POINT rather than /boot/efi on the live image.
              (target-esp (if (file-exists? (string-append mount-point efi-dir))
                              (string-append mount-point efi-dir)
                              efi-dir)))
          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
          ;; root partition.
          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
          (invoke/quiet grub-install "--boot-directory" install-dir
                        "--bootloader-id=Guix"
                        "--efi-directory" target-esp)))))

(define (install-grub-efi-netboot subdir)
  "Define a grub-efi-netboot bootloader installer for installation in SUBDIR,
which is usually efi/Guix or efi/boot."
  (let* ((system (string-split (nix-system->gnu-triplet
                                (or (%current-target-system)
                                    (%current-system)))
                               #\-))
         (arch (first system))
         (boot-efi-link (match system
                          ;; These are the supportend systems and the names
                          ;; defined by the UEFI standard for removable media.
                          (("i686" _ ...)        "/bootia32.efi")
                          (("x86_64" _ ...)      "/bootx64.efi")
                          (("arm" _ ...)         "/bootarm.efi")
                          (("aarch64" _ ...)     "/bootaa64.efi")
                          (("riscv" _ ...)       "/bootriscv32.efi")
                          (("riscv64" _ ...)     "/bootriscv64.efi")
                          ;; Other systems are not supported, although defined.
                          ;; (("riscv128" _ ...) "/bootriscv128.efi")
                          ;; (("ia64" _ ...)     "/bootia64.efi")
                          ((_ ...)               #f)))
         (core-efi (string-append
                    ;; This is the arch dependent file name of GRUB, e.g.
                    ;; i368-efi/core.efi or arm64-efi/core.efi.
                    (match arch
                      ("i686"    "i386")
                      ("aarch64" "arm64")
                      ("riscv"   "riscv32")
                      (_         arch))
                    "-efi/core.efi")))
    (with-imported-modules
     '((guix build union))
     #~(lambda (bootloader target mount-point)
         "Install the BOOTLOADER, which must be the package grub, as e.g.
bootx64.efi or bootaa64.efi into SUBDIR, which is usually efi/Guix or efi/boot,
below the directory TARGET for the system whose root is mounted at MOUNT-POINT.

MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
or '/' for other 'guix system' commands.

TARGET is the target argument given to the bootloader-configuration in

(operating-system
 (bootloader (bootloader-configuration
              (target \"/boot\")
              …))
 …)

TARGET is required to be an absolute directory name, usually mounted via NFS,
and finally needs to be provided by a TFTP server as the TFTP root directory.

GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
load more files from the store like tftp://server/gnu/store/…-linux…/Image.

To make this possible two symlinks will be created. The first symlink points
relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.

It is important to note that these symlinks need to be relativ, as the absolute
paths on the TFTP server side are unknown.

It is also important to note that both symlinks will point outside the TFTP root
directory and that the TARGET/%store-prefix symlink makes the whole store
accessible via TFTP. Possibly the TFTP server must be configured
to allow accesses outside its TFTP root directory. This may need to be
considered for security aspects."
         (use-modules ((guix build union) #:select (symlink-relative)))
         (let* ((net-dir (string-append mount-point target "/"))
                (sub-dir (string-append net-dir #$subdir "/"))
                (store (string-append mount-point (%store-prefix)))
                (store-link (string-append net-dir (%store-prefix)))
                (grub-cfg (string-append mount-point "/boot/grub/grub.cfg"))
                (grub-cfg-link (string-append sub-dir (basename grub-cfg)))
                (boot-efi-link (string-append sub-dir #$boot-efi-link)))
           ;; Prepare the symlink to the store.
           (mkdir-p (dirname store-link))
           (false-if-exception (delete-file store-link))
           (symlink-relative store store-link)
           ;; Prepare the symlink to the grub.cfg, which points into the store.
           (mkdir-p (dirname grub-cfg-link))
           (false-if-exception (delete-file grub-cfg-link))
           (symlink-relative grub-cfg grub-cfg-link)
           ;; Install GRUB, which refers to the grub.cfg, with support for
           ;; encrypted partitions,
           (setenv "GRUB_ENABLE_CRYPTODISK" "y")
           (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
                         (string-append "--net-directory=" net-dir)
                         (string-append "--subdir=" #$subdir))
           ;; Prepare the bootloader symlink, which points to core.efi of GRUB.
           (false-if-exception (delete-file boot-efi-link))
           (symlink #$core-efi boot-efi-link))))))



;;;
;;; Bootloader definitions.
;;;
;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
;;; is fixed.  Inheriting and overwriting the field 'configuration-file' will
;;; break 'guix system delete-generations', 'guix system switch-generation',
;;; and 'guix system roll-back'.

(define grub-bootloader
  (bootloader
   (name 'grub)
   (package grub)
   (installer install-grub)
   (disk-image-installer install-grub-disk-image)
   (configuration-file "/boot/grub/grub.cfg")
   (configuration-file-generator grub-configuration-file)))

(define grub-minimal-bootloader
  (bootloader
   (inherit grub-bootloader)
   (package grub-minimal)))

(define grub-efi-bootloader
  (bootloader
   (inherit grub-bootloader)
   (installer install-grub-efi)
   (disk-image-installer #f)
   (name 'grub-efi)
   (package grub-efi)))

(define grub-efi-netboot-bootloader
  (bootloader
   (inherit grub-efi-bootloader)
   (name 'grub-efi-netboot-bootloader)
   (installer (install-grub-efi-netboot "efi/Guix"))))

(define grub-mkrescue-bootloader
  (bootloader
   (inherit grub-efi-bootloader)
   (package grub-hybrid)))


;;;
;;; Compatibility macros.
;;;

(define-syntax grub-configuration
  (syntax-rules (grub)
                ((_ (grub package) fields ...)
                 (if (eq? package grub)
                     (bootloader-configuration
                      (bootloader grub-bootloader)
                      fields ...)
                   (bootloader-configuration
                    (bootloader grub-efi-bootloader)
                    fields ...)))
                ((_ fields ...)
                 (bootloader-configuration
                  (bootloader grub-bootloader)
                  fields ...))))

;;; grub.scm ends here