Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -620,10 +620,64 @@
 	(loop (max hed max-val)
 	      (car tal)
 	      (cdr tal))
 	(max hed max-val))))
 
+;; path list to hash-table tree
+;;   ((a b c)(a b d)(e b c)) => ((a (b (d) (c))) (e (b (c))))
+;;
+(define (common:list->htree lst)
+  (let ((resh (make-hash-table)))
+    (for-each
+     (lambda (inlst)
+       (let loop ((ht  resh)
+		  (hed (car inlst))
+		  (tal (cdr inlst)))
+	 (if (hash-table-ref/default ht hed #f)
+	     (if (not (null? tal))
+		 (loop (hash-table-ref ht hed)
+		       (car tal)
+		       (cdr tal)))
+	     (begin
+	       (hash-table-set! ht hed (make-hash-table))
+	       (loop ht hed tal)))))
+     lst)
+    resh))
+
+;; hash-table tree to html list tree
+;;
+;;   tipfunc takes two parameters: y the tip value and path the path to that point
+;;
+(define (common:htree->html ht path tipfunc)
+  (let ((datlist 	(hash-table->alist ht)))
+    (if (null? datlist)
+    	(tipfunc #f path) ;; really shouldn't get here
+	(s:ul
+	 (map (lambda (x)
+		(let* ((levelname (car x))
+		       (y         (cdr x))
+		       (newpath   (append path (list levelname)))
+		       (leaf      (or (not (hash-table? y))
+				      (null? (hash-table-keys y)))))
+		  (if leaf
+		      (s:li (tipfunc y newpath))
+		      (s:li
+		       (list 
+			levelname
+			(common:htree->html y newpath tipfunc))))))
+	      datlist)))))
+
+;; hash-table tree to alist tree
+;;
+(define (common:htree->atree ht)
+  (map (lambda (x)
+	 (cons (car x)
+	       (let ((y (cdr x)))
+		 (if (hash-table? y)
+		     (common:htree->atree y)
+		     y))))
+       (hash-table->alist ht)))
 
 ;;======================================================================
 ;; M U N G E   D A T A   I N T O   N I C E   F O R M S
 ;;======================================================================
 

Index: tests.scm
==================================================================
--- tests.scm
+++ tests.scm
@@ -568,10 +568,184 @@
 	;;  state-status-counts
 	;;  (lambda (key val)
 	;;	(append key (list val)))))
 	))))
 
+(define tests:css-jscript-block
+#<<EOF
+<style type="text/css">
+ul.LinkedList { display: block; }
+/* ul.LinkedList ul { display: none; } */
+.HandCursorStyle { cursor: pointer; cursor: hand; }  /* For IE */
+  </style>
+
+  <script type="text/JavaScript">
+    // Add this to the onload event of the BODY element
+    function addEvents() {
+      activateTree(document.getElementById("LinkedList1"));
+    }
+
+    // This function traverses the list and add links 
+    // to nested list items
+    function activateTree(oList) {
+      // Collapse the tree
+      for (var i=0; i < oList.getElementsByTagName("ul").length; i++) {
+        oList.getElementsByTagName("ul")[i].style.display="none";            
+      }                                                                  
+      // Add the click-event handler to the list items
+      if (oList.addEventListener) {
+        oList.addEventListener("click", toggleBranch, false);
+      } else if (oList.attachEvent) { // For IE
+        oList.attachEvent("onclick", toggleBranch);
+      }
+      // Make the nested items look like links
+      addLinksToBranches(oList);
+    }
+
+    // This is the click-event handler
+    function toggleBranch(event) {
+      var oBranch, cSubBranches;
+      if (event.target) {
+        oBranch = event.target;
+      } else if (event.srcElement) { // For IE
+        oBranch = event.srcElement;
+      }
+      cSubBranches = oBranch.getElementsByTagName("ul");
+      if (cSubBranches.length > 0) {
+        if (cSubBranches[0].style.display == "block") {
+          cSubBranches[0].style.display = "none";
+        } else {
+          cSubBranches[0].style.display = "block";
+        }
+      }
+    }
+
+    // This function makes nested list items look like links
+    function addLinksToBranches(oList) {
+      var cBranches = oList.getElementsByTagName("li");
+      var i, n, cSubBranches;
+      if (cBranches.length > 0) {
+        for (i=0, n = cBranches.length; i < n; i++) {
+          cSubBranches = cBranches[i].getElementsByTagName("ul");
+          if (cSubBranches.length > 0) {
+            addLinksToBranches(cSubBranches[0]);
+            cBranches[i].className = "HandCursorStyle";
+            cBranches[i].style.color = "blue";
+            cSubBranches[0].style.color = "black";
+            cSubBranches[0].style.cursor = "auto";
+          }
+        }
+      }
+    }
+  </script>
+EOF
+)
+
+(define (tests:run-record->test-path run numkeys)
+   (append (take (vector->list run) numkeys)
+	   (list (vector-ref run (+ 1 numkeys)))))
+
+;; (tests:create-html-tree "test-index.html")
+;;
+(define (tests:create-html-tree outf)
+  (let* ((lockfile  (conc outf ".lock"))
+	 (runs-to-process '()))
+    (if (common:simple-file-lock lockfile)
+	(let* ((linktree  (common:get-linktree))
+	       (oup       (open-output-file outf))
+	       (area-name (common:get-testsuite-name))
+	       (keys      (rmt:get-keys))
+	       (numkeys   (length keys))
+	       (runsdat   (rmt:get-runs "%" #f #f (map (lambda (x)(list x "%")) keys)))
+	       (header    (vector-ref runsdat 0))
+	       (runs      (vector-ref runsdat 1))
+	       (runtreedat (map (lambda (x)
+				  (tests:run-record->test-path x numkeys))
+				runs))
+	       (runs-htree (common:list->htree runtreedat)))
+	  (set! runs-to-process runs)
+	  (s:output-new
+	   oup
+	   (s:html tests:css-jscript-block
+		   (s:title "Summary for " area-name)
+		   (s:body 'onload "addEvents();"
+			   (s:h1 "Summary for " area-name)
+			   ;; top list
+			   (s:ul 'id "LinkedList1" 'class "LinkedList"
+				 (s:li
+				  "Runs"
+				  (common:htree->html runs-htree
+						      '()
+						      (lambda (x p)
+							(let ((targpath (string-intersperse p "/"))
+							      (runname  (car (reverse p))))
+							  (s:a runname 'href (conc targpath "/runsummary.html"))))
+							    ))))))
+	  (close-output-port oup)
+	  (common:simple-file-release-lock lockfile)
+	  (for-each
+	   (lambda (run)
+	     (let* ((test-subpath (tests:run-record->test-path run numkeys))
+		    (run-id       (db:get-value-by-header run header "id"))
+		    (testdats     (rmt:get-tests-for-run
+				   run-id "%" ;; testnamepatt
+				   '()        ;; states
+				   '()        ;; statuses
+				   #f         ;; offset
+				   #f         ;; num-to-get
+				   #f         ;; hide/not-hide
+				   #f         ;; sort-by
+				   #f         ;; sort-order
+				   #f         ;; 'shortlist                           ;; qrytype
+                                   0         ;; last update
+				   #f)))
+	       (print "testdats: " testdats)))
+	   runs)
+	  #t)
+	#f)))
+
+;;   (let* ((outputfilename (conc "megatest-rollup-" test-name ".html"))
+;; 	 (orig-dir       (current-directory))
+;; 	 (logf-info      (rmt:test-get-logfile-info run-id test-name))
+;; 	 (logf           (if logf-info (cadr logf-info) #f))
+;; 	 (path           (if logf-info (car  logf-info) #f)))
+;;     ;; This query finds the path and changes the directory to it for the test
+;;     (if (and (string? path)
+;; 	     (directory? path)) ;; can get #f here under some wierd conditions. why, unknown ...
+;; 	(begin
+;; 	  (debug:print 4 *default-log-port* "Found path: " path)
+;; 	  (change-directory path))
+;; 	;; (set! outputfilename (conc path "/" outputfilename)))
+;; 	(debug:print-error 0 *default-log-port* "summarize-items for run-id=" run-id ", test-name=" test-name ", no such path: " path))
+;;     (debug:print 4 *default-log-port* "summarize-items with logf " logf ", outputfilename " outputfilename " and force " force)
+;;     (if (or (equal? logf "logs/final.log")
+;; 	    (equal? logf outputfilename)
+;; 	    force)
+;; 	(let ((my-start-time (current-seconds))
+;; 	      (lockf         (conc outputfilename ".lock")))
+;; 	  (let loop ((have-lock  (common:simple-file-lock lockf)))
+;; 	    (if have-lock
+;; 		(let ((script (configf:lookup *configdat* "testrollup" test-name)))
+;; 		  (print "Obtained lock for " outputfilename)
+;; 		  ;; (rmt:top-test-set-per-pf-counts run-id test-name)
+;; 		  (rmt:roll-up-pass-fail-counts run-id test-name "" #f #f)
+;; 		  (rmt:top-test-set-per-pf-counts run-id test-name)
+;; 		  (if script
+;; 		      (system (conc script " > " outputfilename " & "))
+;; 		      (tests:generate-html-summary-for-iterated-test run-id test-id test-name outputfilename))
+;; 		  (change-directory orig-dir)
+;; 		  ;; NB// tests:test-set-toplog! is remote internal...
+;; 		  (tests:test-set-toplog! run-id test-name outputfilename))
+;; 		;; didn't get the lock, check to see if current update started later than this 
+;; 		;; update, if so we can exit without doing any work
+;; 		(if (> my-start-time (file-modification-time lockf))
+;; 		    ;; we started since current re-gen in flight, delay a little and try again
+;; 		    (begin
+;; 		      (debug:print-info 1 *default-log-port* "Waiting to update " outputfilename ", another test currently updating it")
+;; 		      (thread-sleep! (+ 5 (random 5))) ;; delay between 5 and 10 seconds
+;; 		      (loop (common:simple-file-lock lockf))))))))))
+
 ;; CHECK - WAS THIS ADDED OR REMOVED? MANUAL MERGE WITH API STUFF!!!
 ;;
 ;; get a pretty table to summarize steps
 ;;
 ;; (define (dcommon:process-steps-table steps);; db test-id #!key (work-area #f))
@@ -666,11 +840,12 @@
 					 (conc (vector-ref b 2)))
 			       #f))
 		       (string<? (conc time-a)(conc time-b)))))))))
 
 
-;; summarize test
+;; summarize test in to a file test-summary.html in the test directory
+;;
 (define (tests:summarize-test run-id test-id)
   (let* ((test-dat  (rmt:get-test-info-by-id run-id test-id))
 	 (steps-dat (rmt:get-steps-for-test run-id test-id))
 	 (test-name (db:test-get-testname test-dat))
 	 (item-path (db:test-get-item-path test-dat))