ui: 'package->recutils' takes #:extra-fields.

* guix/ui.scm (package->recutils): Add #:extra-fields and honor it.
This commit is contained in:
Ludovic Courtès 2017-06-13 18:09:30 +02:00
parent 5c46c8582f
commit 4ee79f22f5
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -946,9 +946,10 @@ (define (string->recutils str)
'() '()
str))) str)))
(define* (package->recutils p port #:optional (width (%text-width))) (define* (package->recutils p port #:optional (width (%text-width))
#:key (extra-fields '()))
"Write to PORT a `recutils' record of package P, arranging to fit within "Write to PORT a `recutils' record of package P, arranging to fit within
WIDTH columns." WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit."
(define width* (define width*
;; The available number of columns once we've taken into account space for ;; The available number of columns once we've taken into account space for
;; the initial "+ " prefix. ;; the initial "+ " prefix.
@ -993,11 +994,11 @@ (define (package<? p1 p2)
(G_ "unknown")))) (G_ "unknown"))))
(format port "synopsis: ~a~%" (format port "synopsis: ~a~%"
(string-map (match-lambda (string-map (match-lambda
(#\newline #\space) (#\newline #\space)
(chr chr)) (chr chr))
(or (and=> (package-synopsis-string p) P_) (or (and=> (package-synopsis-string p) P_)
""))) "")))
(format port "~a~2%" (format port "~a~%"
(string->recutils (string->recutils
(string-trim-right (string-trim-right
(parameterize ((%text-width width*)) (parameterize ((%text-width width*))
@ -1005,7 +1006,16 @@ (define (package<? p1 p2)
(string-append "description: " (string-append "description: "
(or (and=> (package-description p) P_) (or (and=> (package-description p) P_)
"")))) ""))))
#\newline)))) #\newline)))
(for-each (match-lambda
((field . value)
(let ((field (symbol->string field)))
(format port "~a: ~a~%"
field
(fill-paragraph (object->string value) width*
(string-length field))))))
extra-fields)
(newline port))
(define (string->generations str) (define (string->generations str)
"Return the list of generations matching a pattern in STR. This function "Return the list of generations matching a pattern in STR. This function