diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-10-09 21:52:22 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-10-09 21:52:22 +0200 |
commit | d4f1ce4da000be9e4af7f031b19a04751fb2091f (patch) | |
tree | ae85961a692d4838d2e380d1da0e18fecbb2ce39 /build-aux/list-packages.scm | |
parent | 4e45e352663f51d4b669256373819f8bc6fbd489 (diff) | |
download | patches-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.
Diffstat (limited to 'build-aux/list-packages.scm')
-rwxr-xr-x | build-aux/list-packages.scm | 43 |
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) "")))))) |