summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/profiles.scm144
1 files changed, 71 insertions, 73 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0eb99f40de..5ef84e8a0b 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1117,82 +1117,80 @@ the entries in MANIFEST."
(module-ref (resolve-interface '(gnu packages man)) 'man-db))
(define build
- #~(begin
- (use-modules (guix build utils)
- (srfi srfi-1)
- (srfi srfi-19)
- (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)
- (let* ((start-time (current-time))
- (exit-status (system* #+(file-append man-db "/bin/mandb")
- "--quiet" "--create"
- "-C" "man_db.conf"))
- (duration (time-difference (current-time) start-time)))
- (format #t "done in ~,3f s~%"
- (+ (time-second duration)
- (* (time-nanosecond duration) (expt 10 -9))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-1)
+ (srfi srfi-19)
+ (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? exit-status))))
+ (let* ((start-time (current-time))
+ (exit-status (system* #+(file-append man-db "/bin/mandb")
+ "--quiet" "--create"
+ "-C" "man_db.conf"))
+ (duration (time-difference (current-time) start-time)))
+ (format #t "done in ~,3f s~%"
+ (+ (time-second duration)
+ (* (time-nanosecond duration) (expt 10 -9))))
+ (force-output)
+ (zero? exit-status)))))
(gexp->derivation "manual-database" build
- #:modules '((guix build utils)
- (srfi srfi-19)
- (srfi srfi-26))
#:local-build? #t))
(define %default-profile-hooks