me
/
guix
Archived
1
0
Fork 0
Code

list-packages: Handle 'origin' patches. 

* build-aux/list-packages.scm (package->sxml)[patches]: Handle the case
  where PATCH is an 'origin'.
master
Ludovic Courtès 2014-10-12 15:33:07 +02:00
parent 14e84b2d97
commit 572bcdf0bc
1 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
build-aux/list-packages.scm
View File

@ -100,10 +100,25 @@ decreasing, is 1."
(->sxml (package-license package))) (->sxml (package-license package)))
(define (patches package) (define (patches package)
(define (patch-url patch) (define patch-url
(string-append (match-lambda
"http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/" ((? string? patch)
(basename 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) (define (snippet-link snippet)
(let ((loc (or (package-field-location package 'source) (let ((loc (or (package-field-location package 'source)
@ -134,7 +149,7 @@ decreasing, is 1."
(cons `(a (@ (href ,(patch-url patch)) (cons `(a (@ (href ,(patch-url patch))
(title ,(string-append (title ,(string-append
"Link to " "Link to "
(basename patch)))) (patch-name patch))))
,(number->string number)) ,(number->string number))
links)))))))))) links))))))))))