From 572bcdf0bcd483b168110cb7d25dd6ad28ab9172 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 12 Oct 2014 15:33:07 +0200
Subject: [PATCH] list-packages: Handle 'origin' patches.
* build-aux/list-packages.scm (package->sxml)[patches]: Handle the case
where PATCH is an 'origin'.
---
build-aux/list-packages.scm | 25 ++++++++++++++++++++-----
1 file changed, 20 insertions(+), 5 deletions(-)
diff --git a/build-aux/list-packages.scm b/build-aux/list-packages.scm
index 96fe7072335..7b046fe0c7d 100755
--- a/build-aux/list-packages.scm
+++ b/build-aux/list-packages.scm
@@ -100,10 +100,25 @@ (define ->sxml
(->sxml (package-license package)))
(define (patches package)
- (define (patch-url patch)
- (string-append
- "http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
- (basename patch)))
+ (define patch-url
+ (match-lambda
+ ((? string? patch)
+ (string-append
+ "http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
+ (basename patch)))
+ ((? origin? patch)
+ (match (origin-uri patch)
+ ((? string? uri) uri)
+ ((head . tail) head)))))
+
+ (define patch-name
+ (match-lambda
+ ((? string? patch)
+ (basename patch))
+ ((? origin? patch)
+ (match (origin-uri patch)
+ ((? string? uri) (basename uri))
+ ((head . tail) (basename head))))))
(define (snippet-link snippet)
(let ((loc (or (package-field-location package 'source)
@@ -134,7 +149,7 @@ (define (snippet-link snippet)
(cons `(a (@ (href ,(patch-url patch))
(title ,(string-append
"Link to "
- (basename patch))))
+ (patch-name patch))))
,(number->string number))
links))))))))))
--
GitLab