mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
man-db: Add support for zstd compressed man pages.
* guix/man-db.scm: Autoload zlib and zstd modules. (<mandb-entry>): Adjust comment. (abbreviate-file-name): Adjust regexp. (gz-compressed?, zstd-compressed?): New predicates. (entry->string): Use them. (man-page->entry): Adjust doc. Use input port reader appropriate to the compression type, if any. (man-files): Adjust regexp. (mandb-entries): Adjust link resolving predicate. * guix/profiles.scm (manual-database): Add guile-zlib extension. Change-Id: I6336e46e2d324c520a7d15d6cafd12bbf43c5b09 Reviewed-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Maxim Cournoyer
Ludovic Courtès
parent
dfd18d0d75
commit
8224555802
2 changed files with 41 additions and 12 deletions
|
|
@ -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.
|
||||
;;;
|
||||
|
|
@ -17,7 +18,8 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix man-db)
|
||||
#:use-module (zlib)
|
||||
#:autoload (zlib) (call-with-gzip-input-port)
|
||||
#:autoload (zstd) (call-with-zstd-input-port)
|
||||
#: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 (extract-synopsis str)
|
|||
(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 (string->number* str)
|
|||
(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 (string->number* str)
|
|||
(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)))
|
||||
|
|
|
|||
|
|
@ -1706,6 +1706,9 @@ (define gdbm-ffi
|
|||
(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)
|
||||
|
|
@ -1714,7 +1717,8 @@ (define modules
|
|||
(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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue