X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/a5e2fc73760a2ae023f2e56bdbf8025971f90e64..1306283843c6a933e0dc3bc1eedbc38b687c0d73:/guix/utils.scm

diff --git a/guix/utils.scm b/guix/utils.scm
index 64894ecf1f..b816c355dc 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +30,6 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 ftw)
   #:use-module (rnrs io ports)                    ;need 'port-position' etc.
@@ -44,9 +44,7 @@
   #:use-module (ice-9 format)
   #:use-module ((ice-9 iconv) #:prefix iconv:)
   #:use-module (system foreign)
-  #:re-export (memoize                            ;for backwards compatibility
-
-               <location>
+  #:re-export (<location>                         ;for backwards compatibility
                location
                location?
                location-file
@@ -57,7 +55,11 @@
 
                &error-location
                error-location?
-               error-location)
+               error-location
+
+               &fix-hint
+               fix-hint?
+               condition-fix-hint)
   #:export (strip-keyword-arguments
             default-keyword-arguments
             substitute-keyword-arguments
@@ -65,10 +67,6 @@
 
             current-source-directory
 
-            &fix-hint
-            fix-hint?
-            condition-fix-hint
-
             nix-system->gnu-triplet
             gnu-triplet->nix-system
             %current-system
@@ -85,6 +83,7 @@
             version>?
             version>=?
             version-prefix
+            version-major+minor+point
             version-major+minor
             version-major
             guile-version>?
@@ -209,13 +208,8 @@ buffered data is lost."
 (define (lzip-port proc port . args)
   "Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS.
 Raise an error if lzlib support is missing."
-  (let* ((lzlib       (false-if-exception (resolve-interface '(guix lzlib))))
-         (supported?  (and lzlib
-                           ((module-ref lzlib 'lzlib-available?)))))
-    (if supported?
-        (let ((make-port (module-ref lzlib proc)))
-          (values (make-port port) '()))
-        (error "lzip compression not supported" lzlib))))
+  (let ((make-port (module-ref (resolve-interface '(lzlib)) proc)))
+    (values (make-port port) '())))
 
 (define (decompressed-port compression input)
   "Return an input port where INPUT is decompressed according to COMPRESSION,
@@ -567,6 +561,15 @@ or '= when they denote equal versions."
 For example, (version-prefix \"2.1.47.4.23\" 3) returns \"2.1.47\""
   (string-join (take (string-split version-string #\.) num-parts) "."))
 
+(define (version-major+minor+point version-string)
+  "Return \"major>.<minor>.<point>\", where major, minor and point are the
+major, minor and point version numbers from the version-string.  For example,
+(version-major+minor+point \"6.4.5.2\") returns \"6.4.5\" or
+(version-major+minor+point \"1.19.2-2581-324ca14c3003\") returns \"1.19.2\"."
+  (let* ((3-dot (version-prefix version-string 3))
+         (index (string-index 3-dot #\-)))
+    (or (false-if-exception (substring 3-dot 0 index))
+        3-dot)))
 
 (define (version-major+minor version-string)
   "Return \"<major>.<minor>\", where major and minor are the major and
@@ -835,10 +838,6 @@ be determined."
           ;; raising an error would upset Geiser users
           #f))))))
 
-(define-condition-type &fix-hint &condition
-  fix-hint?
-  (hint condition-fix-hint))                      ;string
-
 ;;; Local Variables:
 ;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
 ;;; End: