From 572bcdf0bcd483b168110cb7d25dd6ad28ab9172 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 12 Oct 2014 15:33:07 +0200 Subject: 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(-) (limited to 'build-aux') diff --git a/build-aux/list-packages.scm b/build-aux/list-packages.scm index 96fe707233..7b046fe0c7 100755 --- a/build-aux/list-packages.scm +++ b/build-aux/list-packages.scm @@ -100,10 +100,25 @@ decreasing, is 1." (->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 @@ decreasing, is 1." (cons `(a (@ (href ,(patch-url patch)) (title ,(string-append "Link to " - (basename patch)))) + (patch-name patch)))) ,(number->string number)) links)))))))))) -- cgit v1.2.3