summaryrefslogtreecommitdiff
path: root/build-aux/list-packages.scm
diff options
context:
space:
mode:
authorAlex Sassmannshausen <alex.sassmannshausen@gmail.com>2013-08-11 19:53:15 +0200
committerLudovic Courtès <ludo@gnu.org>2013-08-15 16:42:29 +0200
commit0938cd27315cc9d0a6591c398c222415b18ca4fc (patch)
tree347d8c3829afba4d9d6f3d3ca4c6061045d1615d /build-aux/list-packages.scm
parent8bdf5241dce2f4c6a59120188d99e23043a2942c (diff)
list-packages: Tidying and refactoring in preparation for substantive changes.
* build-aux/list-packages.scm (package->sxml)[license, status]: Add title for <a> element. Add alt and title for gnu-logo <img> element. Add title to package website <a> element. (packages->sxml): Wrap <div id="intro"> intro paragraph in <p> element. Add table header row to <table id="packages"> Add <a> back to top of the page beneath table. (insert-css, insert-js): New procedures. (list-packages): Move JavaScript to 'insert-js', and CSS to 'insert-css'. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'build-aux/list-packages.scm')
-rwxr-xr-xbuild-aux/list-packages.scm149
1 files changed, 103 insertions, 46 deletions
diff --git a/build-aux/list-packages.scm b/build-aux/list-packages.scm
index ceadbef0fe..d0607878fd 100755
--- a/build-aux/list-packages.scm
+++ b/build-aux/list-packages.scm
@@ -5,6 +5,7 @@ exec guile -l "$0" \
!#
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -65,7 +66,8 @@ exec guile -l "$0" \
(let ((uri (license-uri license)))
(case (and=> (and uri (string->uri uri)) uri-scheme)
((http https)
- `(div (a (@ (href ,uri))
+ `(div (a (@ (href ,uri)
+ (title "Link to the full license"))
,(license-name license))))
(else
`(div ,(license-name license) " ("
@@ -78,7 +80,8 @@ exec guile -l "$0" \
(define (url system)
`(a (@ (href ,(string-append "http://hydra.gnu.org/job/gnu/master/"
(package-full-name package) "."
- system)))
+ system))
+ (title "View the status of this architecture's build at Hydra"))
,system))
`(div "status: "
@@ -92,9 +95,12 @@ exec guile -l "$0" \
(let ((description-id (symbol->string
(gensym (package-name package)))))
`(tr (td ,(if (gnu-package? package)
- `(img (@ (src "/graphics/gnu-head-mini.png")))
+ `(img (@ (src "/graphics/gnu-head-mini.png")
+ (alt "Part of GNU")
+ (title "Part of GNU")))
""))
- (td (a (@ (href ,(source-url package)))
+ (td (a (@ (href ,(source-url package))
+ (title "Link to the Guix package source code"))
,(package-name package) " "
,(package-version package)))
(td (@ (colspan "2") (height "0"))
@@ -104,7 +110,6 @@ exec guile -l "$0" \
description-id)))
,(package-synopsis package))
(div (@ (id ,description-id)
- (class "package-description")
(style "display: none;"))
,(match (package-logo (package-name package))
((? string? url)
@@ -114,7 +119,8 @@ exec guile -l "$0" \
(_ #f))
(p ,(package-description package))
,(license package)
- (a (@ (href ,(package-home-page package)))
+ (a (@ (href ,(package-home-page package))
+ (title "Link to the package's website"))
,(package-home-page package))
,(status package))))))
@@ -127,16 +133,93 @@ exec guile -l "$0" \
(img (@ (src "graphics/guix-logo.small.png")
(alt "GNU Guix and the GNU System")
(height "83em"))))
- "This web page lists the packages currently provided by the "
- (a (@ (href "manual/guix.html#GNU-Distribution"))
- "GNU system distribution")
- " of "
- (a (@ (href "/software/guix/guix.html")) "GNU Guix") ". "
- "Our " (a (@ (href "http://hydra.gnu.org/jobset/gnu/master"))
- "continuous integration system")
- " shows their current build status.")
+ (p "This web page lists the packages currently provided by the "
+ (a (@ (href "manual/guix.html#GNU-Distribution"))
+ "GNU system distribution")
+ " of "
+ (a (@ (href "/software/guix/guix.html")) "GNU Guix") ". "
+ "Our " (a (@ (href "http://hydra.gnu.org/jobset/gnu/master"))
+ "continuous integration system")
+ " shows their current build status."))
(table (@ (id "packages"))
- ,@(map package->sxml packages))))
+ (tr (th "GNU?")
+ (th "Package version")
+ (th "Package details"))
+ ,@(map package->sxml packages))
+ (a (@ (href "#intro")
+ (title "Back to top.")
+ (id "top"))
+ "^")))
+
+
+(define (insert-css)
+ "Return the CSS for the list-packages page."
+ (format #t
+"<style>
+a {transition: all 0.3s}
+div#intro {margin-bottom: 5em}
+div#intro div, div#intro p {padding:0.5em}
+div#intro div {float:left}
+table#packages, table#packages tr, table#packages tbody, table#packages td,
+table#packages th {border: 0px solid black}
+div.package-description {position: relative}
+table#packages tr:nth-child(even) {background-color: #FFF}
+table#packages tr:nth-child(odd) {background-color: #EEE}
+table#packages tr:hover, table#packages tr:focus, table#packages tr:active {background-color: #DDD}
+table#packages tr:first-child, table#packages tr:first-child:hover, table#packages tr:first-child:focus, table#packages tr:first-child:active {
+background-color: #333;
+color: #fff;
+}
+table#packages td
+{
+margin:0px;
+padding:0.2em 0.5em;
+}
+table#packages td:first-child {
+width:10%;
+text-align:center;
+}
+table#packages td:nth-child(2){width:30%;}
+table#packages td:last-child {width:60%}
+img.package-logo {
+float: left;
+padding-right: 1em;
+}
+table#packages span a {float: right}
+a#top {
+position:fixed;
+right:2%;
+bottom:2%;
+font-size:150%;
+background-color:#EEE;
+padding:1.125% 0.75% 0% 0.75%;
+text-decoration:none;
+color:#000;
+border-radius:5px;
+}
+a#top:hover, a#top:focus {
+background-color:#333;
+color:#fff;
+}
+</style>"))
+
+(define (insert-js)
+ "Return the JavaScript for the list-packages page."
+ (format #t
+"<script language=\"javascript\" type=\"text/javascript\">
+// license: CC0
+function show_hide(idThing)
+{
+ var thing = document.getElementById(idThing);
+ if (thing) {
+ if (thing.style.display == \"none\") {
+ thing.style.display = \"\";
+ } else {
+ thing.style.display = \"none\";
+ }
+ }
+}
+</script>"))
(define (list-packages . args)
@@ -154,39 +237,13 @@ with gnu.org server-side include and all that."
(string<? (package-name p1) (package-name p2))))))
(format #t "<!--#include virtual=\"/server/html5-header.html\" -->
<!-- Parent-Version: 1.70 $ -->
-
<title>GNU Guix - GNU Distribution - GNU Project</title>
-<script language=\"javascript\" type=\"text/javascript\">
-// license: CC0
-function show_hide(idThing)
-{
- var thing = document.getElementById(idThing);
- if (thing) {
- if (thing.style.display == \"none\") {
- thing.style.display = \"\";
- } else {
- thing.style.display = \"none\";
- }
- }
-}
-</script>
-<style>
-div#intro {
-margin-bottom: 5em;
-}
-table#packages {
-border: none;
-}
-div.package-description {
-position: relative;
-}
-img.package-logo {
-float: left; padding-right: 1em;
-}
-</style>
-<!--#include virtual=\"/server/banner.html\" -->
")
- (display (sxml->xml (packages->sxml packages)))
+ (insert-css)
+ (insert-js)
+ (format #t "<!--#include virtual=\"/server/banner.html\" -->")
+
+ (sxml->xml (packages->sxml packages))
(format #t "<!--#include virtual=\"/server/footer.html\" -->
<div id=\"footer\">