From a365d7f796d0db711bb67902f65826af9e951d06 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov
Date: Wed, 23 Jan 2013 15:22:34 +0000 Subject: [PATCH] guix-package: Add '--search'. * guix-package.in (find-packages-by-description): New procedure. (show-help): Add '--search'. (%options): Likewise. (guix-package)[process-query]: Add support for '--search'. --- guix-package.in | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 files changed, 50 insertions(+), 0 deletions(-) diff --git a/guix-package.in b/guix-package.in index 85ac358..16a268b 100644 --- a/guix-package.in +++ b/guix-package.in @@ -229,6 +229,39 @@ all of PACKAGES, a list of name/version/output/path tuples." (leave (_ "error: no previous profile; not rolling back~%"))) (else (switch-link))))) +(define (find-packages-by-description rx) + "Search in SYNOPSIS and DESCRIPTION using RX. Return a list of +matching packages." + (define (remove-duplicates pred lst) + ;; Remove duplicates from sorted LST using PRED. + (cond ((null-list? lst) lst) + ((= (length lst) 1) lst) + ((= (length lst) 2) + (if (pred (first lst) (second lst)) (cdr lst) lst)) + ((pred (first lst) (second lst)) + (remove-duplicates pred (cdr lst))) + (else (cons (first lst) (remove-duplicates pred (cdr lst)))))) + + (define (same-location? p1 p2) + ;; Compare locations of two packages. + (eq? (package-location p1) (package-location p2))) + + (remove-duplicates + same-location? + (stable-sort + (fold-packages + (lambda (package result) + (if (or (false-if-exception + (regexp-exec rx (gettext (package-synopsis package)))) + (false-if-exception + (regexp-exec rx (gettext (package-description package))))) + (cons package result) + result)) + '()) + (lambda (p1 p2) + (string (package-name p1) + (package-name p2)))))) + ;;; ;;; Command-line options. @@ -251,6 +284,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) --roll-back roll back to the previous generation")) (newline) (display (_ " + -s, --search=REGEXP search in synopsis and description using REGEXP")) + (display (_ " -p, --profile=PROFILE use PROFILE instead of the user's default profile")) (display (_ " -n, --dry-run show what would be done without actually doing it")) @@ -305,6 +340,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (option '("verbose") #f #f (lambda (opt name arg result) (alist-cons 'verbose? #t result))) + (option '(#\s "search") #t #f + (lambda (opt name arg result) + (cons `(query search ,(or arg "")) + result))) (option '(#\I "list-installed") #f #t (lambda (opt name arg result) (cons `(query list-installed ,(or arg "")) @@ -525,6 +564,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) name (or version "?") output path)))) installed) #t)) + (('list-available regexp) (let* ((regexp (and regexp (make-regexp regexp))) (available (fold-packages @@ -547,6 +587,16 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (string (package-name p1) (package-name p2))))) #t)) + + (('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)))) + (find-packages-by-description regexp)) + #t)) (_ #f)))) (setlocale LC_ALL "") -- 1.7.5.4