nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

* 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

33
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 (source-url package) (define (location-url loc)
(let ((loc (package-location package)))
(and loc
(string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/" (string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
(location-file loc) "#n" (location-file loc) "#n"
(number->string (location-line loc)))))) (number->string (location-line loc))))
(define (source-url package)
(let ((loc (package-location package)))
(and loc (location-url loc))))
(define (license package) (define (license package)
(define ->sxml (define ->sxml
@ -103,16 +105,28 @@ 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))
(title "Link to patch snippet"))
"snippet")))
(and (origin? (package-source package))
(let ((patches (origin-patches (package-source package)))
(snippet (origin-snippet (package-source package))))
(and (or (pair? patches) snippet)
`(div "patches: " `(div "patches: "
,(let loop ((patches patches) ,(let loop ((patches patches)
(number 1) (number 1)
(links '())) (links '()))
(match patches (match patches
(() (()
(list-join (reverse links) ", ")) (let* ((additional (and snippet
(snippet-link snippet)))
(links (if additional
(cons additional links)
links)))
(list-join (reverse links) ", ")))
((patch rest ...) ((patch rest ...)
(loop rest (loop rest
(+ 1 number) (+ 1 number)
@ -121,8 +135,7 @@ decreasing, is 1."
"Link to " "Link to "
(basename patch)))) (basename patch))))
,(number->string number)) ,(number->string number))
links))))))) links))))))))))
(_ #f)))
(define (status package) (define (status package)
(define (url system) (define (url system)