profiles: Generate database file for man pages.

The mandb database file (index.db) is used by the "apropos" (whatis) or
"man -k" commands.  This change introduces a profile hook to generate
such database file.

* guix/profiles.scm (manual-database): New procedure.
(%default-profile-hooks): Add it.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Maxim Cournoyer 2017-04-05 01:09:22 -07:00 committed by Ludovic Courtès
parent 1618006d0b
commit a0b87ef8ec
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 79 additions and 0 deletions

View File

@ -7,6 +7,7 @@
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -946,10 +947,88 @@ files for the fonts of the @var{manifest} entries."
#:local-build? #t
#:substitutable? #f))
(define (manual-database manifest)
"Return a derivation that builds the manual page database (\"mandb\") for
the entries in MANIFEST."
(define man-db ;lazy reference
(module-ref (resolve-interface '(gnu packages man)) 'man-db))
(define build
#~(begin
(use-modules (guix build utils)
(srfi srfi-1)
(srfi srfi-26))
(define entries
(filter-map (lambda (directory)
(let ((man (string-append directory "/share/man")))
(and (directory-exists? man)
man)))
'#$(manifest-inputs manifest)))
(define manpages-collection-dir
(string-append (getenv "PWD") "/manpages-collection"))
(define man-directory
(string-append #$output "/share/man"))
(define (get-manpage-tail-path manpage-path)
(let ((index (string-contains manpage-path "/share/man/")))
(unless index
(error "Manual path doesn't contain \"/share/man/\":"
manpage-path))
(string-drop manpage-path (+ index (string-length "/share/man/")))))
(define (populate-manpages-collection-dir entries)
(let ((manpages (append-map (cut find-files <> #:stat stat) entries)))
(for-each (lambda (manpage)
(let* ((dest-file (string-append
manpages-collection-dir "/"
(get-manpage-tail-path manpage))))
(mkdir-p (dirname dest-file))
(catch 'system-error
(lambda ()
(symlink manpage dest-file))
(lambda args
;; Different packages may contain the same
;; manpage. Simply ignore the symlink error.
#t))))
manpages)))
(mkdir-p manpages-collection-dir)
(populate-manpages-collection-dir entries)
;; Create a mandb config file which contains a custom made
;; manpath. The associated catpath is the location where the database
;; gets generated.
(copy-file #+(file-append man-db "/etc/man_db.conf")
"man_db.conf")
(substitute* "man_db.conf"
(("MANDB_MAP /usr/man /var/cache/man/fsstnd")
(string-append "MANDB_MAP " manpages-collection-dir " "
man-directory)))
(mkdir-p man-directory)
(setenv "MANPATH" (string-join entries ":"))
(format #t "creating manual page database for ~a packages...~%"
(length entries))
(force-output)
(zero? (system* #+(file-append man-db "/bin/mandb")
"--quiet" "--create"
"-C" "man_db.conf"))))
(gexp->derivation "manual-database" build
#:modules '((guix build utils)
(srfi srfi-26))
#:local-build? #t))
(define %default-profile-hooks
;; This is the list of derivation-returning procedures that are called by
;; default when making a non-empty profile.
(list info-dir-file
manual-database
fonts-dir-file
ghc-package-cache-file
ca-certificate-bundle