From 0938cd27315cc9d0a6591c398c222415b18ca4fc Mon Sep 17 00:00:00 2001
From: Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
Date: Sun, 11 Aug 2013 19:53:15 +0200
Subject: list-packages: Tidying and refactoring in preparation for substantive
 changes.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* 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>
---
 build-aux/list-packages.scm | 149 ++++++++++++++++++++++++++++++--------------
 1 file changed, 103 insertions(+), 46 deletions(-)

(limited to 'build-aux')

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\">
 
-- 
cgit 1.4.1