ui: Add 'make-regexp*'.
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.master
parent
35b50a7535
commit
fd688c82bf
|
@ -435,14 +435,14 @@ return the new list of manifest entries."
|
||||||
(define upgrade-regexps
|
(define upgrade-regexps
|
||||||
(filter-map (match-lambda
|
(filter-map (match-lambda
|
||||||
(('upgrade . regexp)
|
(('upgrade . regexp)
|
||||||
(make-regexp (or regexp "")))
|
(make-regexp* (or regexp "")))
|
||||||
(_ #f))
|
(_ #f))
|
||||||
opts))
|
opts))
|
||||||
|
|
||||||
(define do-not-upgrade-regexps
|
(define do-not-upgrade-regexps
|
||||||
(filter-map (match-lambda
|
(filter-map (match-lambda
|
||||||
(('do-not-upgrade . regexp)
|
(('do-not-upgrade . regexp)
|
||||||
(make-regexp regexp))
|
(make-regexp* regexp))
|
||||||
(_ #f))
|
(_ #f))
|
||||||
opts))
|
opts))
|
||||||
|
|
||||||
|
@ -736,7 +736,7 @@ more information.~%"))
|
||||||
#t)
|
#t)
|
||||||
|
|
||||||
(('list-installed regexp)
|
(('list-installed regexp)
|
||||||
(let* ((regexp (and regexp (make-regexp regexp)))
|
(let* ((regexp (and regexp (make-regexp* regexp)))
|
||||||
(manifest (profile-manifest profile))
|
(manifest (profile-manifest profile))
|
||||||
(installed (manifest-entries manifest)))
|
(installed (manifest-entries manifest)))
|
||||||
(leave-on-EPIPE
|
(leave-on-EPIPE
|
||||||
|
@ -752,7 +752,7 @@ more information.~%"))
|
||||||
#t))
|
#t))
|
||||||
|
|
||||||
(('list-available regexp)
|
(('list-available regexp)
|
||||||
(let* ((regexp (and regexp (make-regexp regexp)))
|
(let* ((regexp (and regexp (make-regexp* regexp)))
|
||||||
(available (fold-packages
|
(available (fold-packages
|
||||||
(lambda (p r)
|
(lambda (p r)
|
||||||
(let ((n (package-name p)))
|
(let ((n (package-name p)))
|
||||||
|
@ -778,7 +778,7 @@ more information.~%"))
|
||||||
#t))
|
#t))
|
||||||
|
|
||||||
(('search regexp)
|
(('search regexp)
|
||||||
(let ((regexp (make-regexp regexp regexp/icase)))
|
(let ((regexp (make-regexp* regexp regexp/icase)))
|
||||||
(leave-on-EPIPE
|
(leave-on-EPIPE
|
||||||
(for-each (cute package->recutils <> (current-output-port))
|
(for-each (cute package->recutils <> (current-output-port))
|
||||||
(find-packages-by-description regexp)))
|
(find-packages-by-description regexp)))
|
||||||
|
|
11
guix/ui.scm
11
guix/ui.scm
|
@ -61,6 +61,7 @@
|
||||||
warn-about-load-error
|
warn-about-load-error
|
||||||
show-version-and-exit
|
show-version-and-exit
|
||||||
show-bug-report-information
|
show-bug-report-information
|
||||||
|
make-regexp*
|
||||||
string->number*
|
string->number*
|
||||||
size->number
|
size->number
|
||||||
show-derivation-outputs
|
show-derivation-outputs
|
||||||
|
@ -350,6 +351,16 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
|
||||||
(list (strerror (car errno)) target)
|
(list (strerror (car errno)) target)
|
||||||
(list errno)))))))
|
(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)
|
(define (string->number* str)
|
||||||
"Like `string->number', but error out with an error message on failure."
|
"Like `string->number', but error out with an error message on failure."
|
||||||
(or (string->number str)
|
(or (string->number str)
|
||||||
|
|
Loading…
Reference in New Issue