01/02: ui: Add 'make-regexp*'.

[Ludovic Court�s]

civodul pushed a commit to branch master
in repository guix.

commit fd688c82bf4ee543dbb5f55bf3913668c4bf4483
Author: Ludovic Courtès <address@hidden>
Date:   Wed Oct 28 15:53:17 2015 +0100

    ui: Add 'make-regexp*'.
    
    Fixes <http://bugs.gnu.org/21773>.
    Reported by Jan Synáček <address@hidden>.
    
    * guix/ui.scm (make-regexp*): New procedure.
    * guix/scripts/package.scm (options->installable, guix-package): Use it
      when processing user-provided regexps.
---
 guix/scripts/package.scm |   10 +++++-----
 guix/ui.scm              |   11 +++++++++++
 2 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d868949..adbc4a1 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -435,14 +435,14 @@ return the new list of manifest entries."
   (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 @@ more information.~%"))
          #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 @@ more information.~%"))
            #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 @@ more information.~%"))
            #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)))
diff --git a/guix/ui.scm b/guix/ui.scm
index 72208e7..312c2a0 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -61,6 +61,7 @@
             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 @@ General help using GNU software: 
<http://www.gnu.org/gethelp/>"))
                  (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)