Skip to content
Snippets Groups Projects
Commit fd688c82 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

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.
parent 35b50a75
No related branches found
No related tags found
No related merge requests found
...@@ -435,14 +435,14 @@ (define (package->manifest-entry* package output) ...@@ -435,14 +435,14 @@ (define (package->manifest-entry* package output)
(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 @@ (define (list-generation number) ...@@ -736,7 +736,7 @@ (define (list-generation number)
#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 @@ (define (list-generation number) ...@@ -752,7 +752,7 @@ (define (list-generation number)
#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 @@ (define (list-generation number) ...@@ -778,7 +778,7 @@ (define (list-generation number)
#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)))
......
...@@ -61,6 +61,7 @@ (define-module (guix ui) ...@@ -61,6 +61,7 @@ (define-module (guix ui)
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 @@ (define (show-bug-report-information) ...@@ -350,6 +351,16 @@ (define (show-bug-report-information)
(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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment