ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

ui: Add 'make-regexp*'.

Browse source 
Fixes <http://bugs.gnu.org/21773>.
Reported by Jan Synáček <jan.synacek@gmail.com>.

* guix/ui.scm (make-regexp*): New procedure.
* guix/scripts/package.scm (options->installable, guix-package): Use it
  when processing user-provided regexps.
This commit is contained in:
Ludovic Courtès 2015-10-28 15:53:17 +01:00
parent 35b50a7535
commit fd688c82bf
2 changed files with 16 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
guix/scripts/package.scm
View file

@ -435,14 +435,14 @@ (define (package->manifest-entry* package output)
(define upgrade-regexps
(filter-map (match-lambda
(('upgrade . regexp)
(make-regexp (or regexp "")))
(make-regexp* (or regexp "")))
(_ #f))
opts))
(define do-not-upgrade-regexps
(filter-map (match-lambda
(('do-not-upgrade . regexp)
(make-regexp regexp))
(make-regexp* regexp))
(_ #f))
opts))
@ -736,7 +736,7 @@ (define (list-generation number)
#t)
(('list-installed regexp)
(let* ((regexp (and regexp (make-regexp regexp)))
(let* ((regexp (and regexp (make-regexp* regexp)))
(manifest (profile-manifest profile))
(installed (manifest-entries manifest)))
(leave-on-EPIPE
@ -752,7 +752,7 @@ (define (list-generation number)
#t))
(('list-available regexp)
(let* ((regexp (and regexp (make-regexp regexp)))
(let* ((regexp (and regexp (make-regexp* regexp)))
(available (fold-packages
(lambda (p r)
(let ((n (package-name p)))
@ -778,7 +778,7 @@ (define (list-generation number)
#t))
(('search regexp)
(let ((regexp (make-regexp regexp regexp/icase)))
(let ((regexp (make-regexp* regexp regexp/icase)))
(leave-on-EPIPE
(for-each (cute package->recutils <> (current-output-port))
(find-packages-by-description regexp)))

11
guix/ui.scm
View file

@ -61,6 +61,7 @@ (define-module (guix ui)
warn-about-load-error
show-version-and-exit
show-bug-report-information
make-regexp*
string->number*
size->number
show-derivation-outputs
@ -350,6 +351,16 @@ (define (show-bug-report-information)
(list (strerror (car errno)) target)
(list errno)))))))
(define (make-regexp* regexp . flags)
"Like 'make-regexp' but error out if REGEXP is invalid, reporting the error
nicely."
(catch 'regular-expression-syntax
(lambda ()
(apply make-regexp regexp flags))
(lambda (key proc message . rest)
(leave (_ "'~a' is not a valid regular expression: ~a~%")
regexp message))))
(define (string->number* str)
"Like `string->number', but error out with an error message on failure."
(or (string->number str)