diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 17 | ||||
| -rw-r--r-- | guix-package.in | 6 | ||||
| -rw-r--r-- | guix/ui.scm | 102 | ||||
| -rw-r--r-- | tests/guix-package.sh | 2 | ||||
| -rw-r--r-- | tests/ui.scm | 70 |
6 files changed, 188 insertions, 10 deletions
diff --git a/Makefile.am b/Makefile.am index 439b5ff5b4..8588266501 100644 --- a/Makefile.am +++ b/Makefile.am @@ -234,6 +234,7 @@ TESTS = \ tests/base32.scm \ tests/builders.scm \ tests/derivations.scm \ + tests/ui.scm \ tests/utils.scm \ tests/build-utils.scm \ tests/packages.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 410e6fa37c..3fee24db50 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -546,10 +546,21 @@ availability of packages: @item --search=@var{regexp} @itemx -s @var{regexp} List the available packages whose synopsis or description matches -@var{regexp}. +@var{regexp}. Print all the meta-data of matching packages in +@code{recutils} format (@pxref{Top, GNU recutils databases,, recutils, +GNU recutils manual}). -For each package, print the following items, separated by tabs: its -name, version, and the source location of its definition. +This allows specific fields to be extracted using the @command{recsel} +command, for instance: + +@example +$ guix-package -s malloc | recsel -p name,version +name: glibc +version: 2.17 + +name: libgc +version: 7.2alpha6 +@end example @item --list-installed[=@var{regexp}] @itemx -I [@var{regexp}] diff --git a/guix-package.in b/guix-package.in index 58164c6e46..e0c3287b3c 100644 --- a/guix-package.in +++ b/guix-package.in @@ -597,11 +597,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (('search regexp) (let ((regexp (and regexp (make-regexp regexp)))) - (for-each (lambda (p) - (format #t "~a\t~a\t~a~%" - (package-name p) - (package-version p) - (location->string (package-location p)))) + (for-each (cute package->recutils <> (current-output-port)) (find-packages-by-description regexp)) #t)) (_ #f)))) diff --git a/guix/ui.scm b/guix/ui.scm index 3ec7be771b..4aa93de3b4 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -21,6 +21,9 @@ #:use-module (guix store) #:use-module (guix config) #:use-module (guix packages) + #:use-module ((guix licenses) #:select (license? license-name)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (ice-9 match) @@ -32,7 +35,10 @@ show-bug-report-information call-with-error-handling with-error-handling - location->string)) + location->string + fill-paragraph + string->recutils + package->recutils)) ;;; Commentary: ;;; @@ -110,4 +116,98 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) (($ <location> file line column) (format #f "~a:~a:~a" file line column)))) +(define* (fill-paragraph str width #:optional (column 0)) + "Fill STR such that each line contains at most WIDTH characters, assuming +that the first character is at COLUMN. + +When STR contains a single line break surrounded by other characters, it is +converted to a space; sequences of more than one line break are preserved." + (define (maybe-break chr result) + (match result + ((column newlines chars) + (case chr + ((#\newline) + `(,column ,(+ 1 newlines) ,chars)) + (else + (let ((chars (case newlines + ((0) chars) + ((1) (cons #\space chars)) + (else + (append (make-list newlines #\newline) chars)))) + (column (case newlines + ((0) column) + ((1) (+ 1 column)) + (else 0)))) + (let ((chars (cons chr chars)) + (column (+ 1 column))) + (if (> column width) + (let*-values (((before after) + (break (cut eqv? #\space <>) chars)) + ((len) + (length before))) + (if (<= len width) + `(,len + 0 + ,(if (null? after) + before + (append before (cons #\newline (cdr after))))) + `(,column 0 ,chars))) ; unbreakable + `(,column 0 ,chars))))))))) + + (match (string-fold maybe-break + `(,column 0 ()) + str) + ((_ _ chars) + (list->string (reverse chars))))) + +(define (string->recutils str) + "Return a version of STR where newlines have been replaced by newlines +followed by \"+ \", which makes for a valid multi-line field value in the +`recutils' syntax." + (list->string + (string-fold-right (lambda (chr result) + (if (eqv? chr #\newline) + (cons* chr #\+ #\space result) + (cons chr result))) + '() + str))) + +(define* (package->recutils p port + #:optional (width (or (and=> (getenv "WIDTH") + string->number) + 80))) + "Write to PORT a `recutils' record of package P, arranging to fit within +WIDTH columns." + (define (description->recutils str) + (let ((str (_ str))) + (string->recutils + (fill-paragraph str width + (string-length "description: "))))) + + ;; Note: Don't i18n field names so that people can post-process it. + (format port "name: ~a~%" (package-name p)) + (format port "version: ~a~%" (package-version p)) + (format port "location: ~a~%" + (or (and=> (package-location p) location->string) + (_ "unknown"))) + (format port "home-page: ~a~%" (package-home-page p)) + (format port "license: ~a~%" + (match (package-license p) + (((? license? licenses) ...) + (string-join (map license-name licenses) + ", ")) + ((? license? license) + (license-name license)) + (x + (_ "unknown")))) + (format port "synopsis: ~a~%" + (string-map (match-lambda + (#\newline #\space) + (chr chr)) + (or (and=> (package-synopsis p) _) + ""))) + (format port "description: ~a~%" + (and=> (package-description p) description->recutils)) + (newline port)) + ;;; ui.scm ends here diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 0b31b55103..42a1f8da96 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -70,7 +70,7 @@ then test "`guix-package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap" # Search. - test "`guix-package -s "GNU Hello" | cut -f1`" = "hello" + test "`guix-package -s "GNU Hello" | grep ^name:`" = "name: hello" test "`guix-package -s "n0t4r341p4ck4g3"`" = "" # Remove a package. diff --git a/tests/ui.scm b/tests/ui.scm new file mode 100644 index 0000000000..0b6f3c5815 --- /dev/null +++ b/tests/ui.scm @@ -0,0 +1,70 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + + +(define-module (test-ui) + #:use-module (guix ui) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +;; Test the (guix ui) module. + +(define %paragraph + "GNU Guile is an implementation of the Scheme programming language, with +support for many SRFIs, packaged for use in a wide variety of environments. +In addition to implementing the R5RS Scheme standard and a large subset of +R6RS, Guile includes a module system, full access to POSIX system calls, +networking support, multiple threads, dynamic linking, a foreign function call +interface, and powerful string processing.") + + +(test-begin "ui") + +(test-assert "fill-paragraph" + (every (lambda (column) + (every (lambda (width) + (every (lambda (line) + (<= (string-length line) width)) + (string-split (fill-paragraph %paragraph + width column) + #\newline))) + '(15 30 35 40 45 50 60 70 80 90 100))) + '(0 5))) + +(test-assert "fill-paragraph, consecutive newlines" + (every (lambda (width) + (any (lambda (line) + (string-prefix? "When STR" line)) + (string-split + (fill-paragraph (procedure-documentation fill-paragraph) + width) + #\newline))) + '(15 20 25 30 40 50 60))) + +(test-equal "fill-paragraph, large unbreakable word" + '("Here is a" "very-very-long-word" + "and that's" "it.") + (string-split + (fill-paragraph "Here is a very-very-long-word and that's it." + 10) + #\newline)) + +(test-end "ui") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) |