summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-10-09 21:52:22 +0200
committerLudovic Courtès <ludo@gnu.org>2013-10-09 21:52:22 +0200
commitd4f1ce4da000be9e4af7f031b19a04751fb2091f (patch)
treeae85961a692d4838d2e380d1da0e18fecbb2ce39
parent4e45e352663f51d4b669256373819f8bc6fbd489 (diff)
downloadpatches-d4f1ce4da000be9e4af7f031b19a04751fb2091f.tar
patches-d4f1ce4da000be9e4af7f031b19a04751fb2091f.tar.gz
list-packages: Show a list of patches for each package.
* build-aux/list-packages.scm (list-join): New procedure. (package->sxml)[patch-url]: New procedure. Use it.
-rwxr-xr-xbuild-aux/list-packages.scm43
1 files changed, 43 insertions, 0 deletions
diff --git a/build-aux/list-packages.scm b/build-aux/list-packages.scm
index 60c9bc39da..6e73cffb86 100755
--- a/build-aux/list-packages.scm
+++ b/build-aux/list-packages.scm
@@ -49,6 +49,21 @@ exec guile -l "$0" \
(equal? (gnu-package-name package) name))
gnu))))
+(define (list-join lst item)
+ "Join the items in LST by inserting ITEM between each pair of elements."
+ (let loop ((lst lst)
+ (result '()))
+ (match lst
+ (()
+ (match (reverse result)
+ (()
+ '())
+ ((_ rest ...)
+ rest)))
+ ((head tail ...)
+ (loop tail
+ (cons* head item result))))))
+
(define (package->sxml package previous description-ids remaining)
"Return 3 values: the HTML-as-SXML for PACKAGE added to all previously
collected package output in PREVIOUS, a list of DESCRIPTION-IDS and the number
@@ -82,6 +97,33 @@ 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)))
+
+ (match (and (origin? (package-source package))
+ (origin-patches (package-source package)))
+ ((patches ..1)
+ `(div "patches: "
+ ,(let loop ((patches patches)
+ (number 1)
+ (links '()))
+ (match patches
+ (()
+ (list-join (reverse links) ", "))
+ ((patch rest ...)
+ (loop rest
+ (+ 1 number)
+ (cons `(a (@ (href ,(patch-url patch))
+ (title ,(string-append
+ "Link to "
+ (basename patch))))
+ ,(number->string number))
+ links)))))))
+ (_ #f)))
+
(define (status package)
(define (url system)
`(a (@ (href ,(string-append "http://hydra.gnu.org/job/gnu/master/"
@@ -133,6 +175,7 @@ description-ids as formal parameters."
(title "Link to the package's website"))
,(package-home-page package))
,(status package)
+ ,(patches package)
,(if js?
(insert-js-call description-ids)
""))))))