me/guix
Archived
1
0
Fork 0
Code Activity

list-packages: Produce link to the origin snippet, if any.

Browse source 
* build-aux/list-packages.scm (package->sxml)[patches](snippet-link):
  New procedure.
  Use it to produce a link to the 'origin-snippet', if any.
This commit is contained in:
Ludovic Courtès 2013-11-19 00:01:46 +01:00
parent 0b8749b7bd
commit a2543006f8
1 changed files with 37 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
build-aux/list-packages.scm
View file

@ -71,12 +71,14 @@ of packages still to be processed in REMAINING. Also Introduces a call to the
JavaScript prep_pkg_descs function as part of the output of PACKAGE, every JavaScript prep_pkg_descs function as part of the output of PACKAGE, every
time the length of DESCRIPTION-IDS, increasing, is 15 or when REMAINING, time the length of DESCRIPTION-IDS, increasing, is 15 or when REMAINING,
decreasing, is 1." decreasing, is 1."
(define (location-url loc)
(string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
(location-file loc) "#n"
(number->string (location-line loc))))
(define (source-url package) (define (source-url package)
(let ((loc (package-location package))) (let ((loc (package-location package)))
(and loc (and loc (location-url loc))))
(string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
(location-file loc) "#n"
(number->string (location-line loc))))))
(define (license package) (define (license package)
(define ->sxml (define ->sxml
@ -103,26 +105,37 @@ decreasing, is 1."
"http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/" "http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
(basename patch))) (basename patch)))
(match (and (origin? (package-source package)) (define (snippet-link snippet)
(origin-patches (package-source package))) (let ((loc (package-field-location package 'source)))
((patches ..1) `(a (@ (href ,(location-url loc))
`(div "patches: " (title "Link to patch snippet"))
,(let loop ((patches patches) "snippet")))
(number 1)
(links '())) (and (origin? (package-source package))
(match patches (let ((patches (origin-patches (package-source package)))
(() (snippet (origin-snippet (package-source package))))
(list-join (reverse links) ", ")) (and (or (pair? patches) snippet)
((patch rest ...) `(div "patches: "
(loop rest ,(let loop ((patches patches)
(+ 1 number) (number 1)
(cons `(a (@ (href ,(patch-url patch)) (links '()))
(title ,(string-append (match patches
"Link to " (()
(basename patch)))) (let* ((additional (and snippet
,(number->string number)) (snippet-link snippet)))
links))))))) (links (if additional
(_ #f))) (cons additional links)
links)))
(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))))))))))
(define (status package) (define (status package)
(define (url system) (define (url system)