Megatest

Diff
Login

Differences From Artifact [cacda34afd]:

To Artifact [69895b157d]:


644
645
646
647
648
649
650



651
652
653
654
655












656
657
658
659
660
661


662
663
664
665
666
667
668
669
644
645
646
647
648
649
650
651
652
653





654
655
656
657
658
659
660
661
662
663
664
665






666
667

668
669
670
671
672
673
674







+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
-







    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)))
	    (s:li
	     levelname
	(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
	     (let ((y       (cdr x))
		   (newpath (append path (list levelname))))
	       ;; (print "levelname=" levelname " newpath=" newpath)
	       (if (hash-table? y)
		   (common:htree->html y newpath tipfunc)
		   (tipfunc y newpath))))))
			(common:htree->html y newpath tipfunc))))))
	      datlist)))))
	(hash-table->alist ht))))

;; hash-table tree to alist tree
;;
(define (common:htree->atree ht)
  (map (lambda (x)
	 (cons (car x)
	       (let ((y (cdr x)))