@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,6 +19,7 @@
(define-module (guix man-db)
#:use-module (zlib)
+ #:use-module (zstd)
#:use-module ((guix build utils) #:select (find-files))
#:use-module (gdbm) ;gdbm-ffi
#:use-module (srfi srfi-9)
@@ -48,7 +50,7 @@ (define-module (guix man-db)
(define-record-type <mandb-entry>
(mandb-entry file-name name section synopsis kind)
mandb-entry?
- (file-name mandb-entry-file-name) ;e.g., "../abiword.1.gz"
+ (file-name mandb-entry-file-name) ;e.g., "../abiword.1.zst"
(name mandb-entry-name) ;e.g., "ABIWORD"
(section mandb-entry-section) ;number
(synopsis mandb-entry-synopsis) ;string
@@ -63,7 +65,7 @@ (define (mandb-entry<? entry1 entry2)
(string<? (basename file1) (basename file2))))))))
(define abbreviate-file-name
- (let ((man-file-rx (make-regexp "(.+)\\.[0-9][a-z]?(\\.gz)?$")))
+ (let ((man-file-rx (make-regexp "(.+)\\.[0-9][a-z]?(\\.(gz|zst))?$")))
(lambda (file)
(match (regexp-exec man-file-rx (basename file))
(#f
@@ -71,6 +73,14 @@ (define abbreviate-file-name
(matches
(match:substring matches 1))))))
+(define (gzip-compressed? file-name)
+ "True if FILE-NAME is suffixed with the '.gz' file extension."
+ (string-suffix? ".gz" file-name))
+
+(define (zstd-compressed? file-name)
+ "True if FILE-NAME is suffixed with the '.zst' file extension."
+ (string-suffix? ".zst" file-name))
+
(define (entry->string entry)
"Return the wire format for ENTRY as a string."
(match entry
@@ -92,7 +102,11 @@ (define (entry->string entry)
"\t-\t-\t"
- (if (string-suffix? ".gz" file) "gz" "")
+ (cond
+ ((gzip-compressed? file) "gz")
+ ((zstd-compressed? file) "zst")
+ (else ""))
+
"\t"
synopsis "\x00"))))
@@ -148,7 +162,8 @@ (define (read-synopsis port)
(loop (cons line lines))))))
(define* (man-page->entry file #:optional (resolve identity))
- "Parse FILE, a gzipped man page, and return a <mandb-entry> for it."
+ "Parse FILE, a gzip or zstd compressed man page, and return a <mandb-entry>
+for it."
(define (string->number* str)
(if (and (string-prefix? "\"" str)
(> (string-length str) 1)
@@ -156,8 +171,13 @@ (define* (man-page->entry file #:optional (resolve identity))
(string->number (string-drop (string-drop-right str 1) 1))
(string->number str)))
- ;; Note: This works for both gzipped and uncompressed files.
- (call-with-gzip-input-port (open-file file "r0")
+ (define call-with-input-port*
+ (cond
+ ((gzip-compressed? file) call-with-gzip-input-port)
+ ((zstd-compressed? file) call-with-zstd-input-port)
+ (else call-with-port)))
+
+ (call-with-input-port* (open-file file "r0")
(lambda (port)
(let loop ((name #f)
(section #f)
@@ -191,14 +211,19 @@ (define* (man-page->entry file #:optional (resolve identity))
(define (man-files directory)
"Return the list of man pages found under DIRECTORY, recursively."
;; Filter the list to ensure that broken symlinks are excluded.
- (filter file-exists? (find-files directory "\\.[0-9][a-z]?(\\.gz)?$")))
+ (filter file-exists?
+ (find-files directory "\\.[0-9][a-z]?(\\.(gz|zst))?$")))
(define (mandb-entries directory)
"Return mandb entries for the man pages found under DIRECTORY, recursively."
(map (lambda (file)
(man-page->entry file
(lambda (link)
- (let ((file (string-append directory "/" link
- ".gz")))
- (and (file-exists? file) file)))))
+ (let ((file-gz (string-append directory "/" link
+ ".gz"))
+ (file-zst (string-append directory "/" link
+ ".zst")))
+ (and (or (file-exists? file-gz)
+ (file-exists? file-zst) file)
+ file)))))
(man-files directory)))
@@ -7,7 +7,7 @@
;;; Copyright © 2016, 2017, 2018, 2019, 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
-;;; Copyright © 2017, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2017, 2021, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
@@ -1701,6 +1701,9 @@ (define* (manual-database manifest #:optional system)
(define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
+ (define guile-zstd
+ (module-ref (resolve-interface '(gnu packages guile)) 'guile-zstd))
+
(define modules
(delete '(guix config)
(source-module-closure `((guix build utils)
@@ -1709,7 +1712,8 @@ (define* (manual-database manifest #:optional system)
(define build
(with-imported-modules modules
(with-extensions (list gdbm-ffi ;for (guix man-db)
- guile-zlib)
+ guile-zlib
+ guile-zstd)
#~(begin
(use-modules (guix man-db)
(guix build utils)