Megatest

;; (import data-structures)
;; (import chicken)

(use typed-records (prefix dbi dbi:))

;; given a configdat lookup the connection info and open the db
;;
(define (pgdb:open configdat #!key (dbname #f)(dbispec #f))  
  (let ((pgconf (or dbispec
		    (args:get-arg "-pgsync")
		    (if configdat
			(configf:lookup configdat "ext-sync" (or dbname "pgdb"))
			#f)
		    )))
    (if pgconf
	(let* ((confdat (map (lambda (conf-item)
			       (let ((parts (string-split conf-item ":")))
				 (if (> (length parts) 1)
				     (let ((key (car parts))
					   (val (cadr parts)))
				       (cons (string->symbol key) val))

	      (coldat (hash-table-ref/default data first #f)))
	 (if (not coldat)(let ((newht (make-hash-table)))
			   (hash-table-set! data first newht)
			   (set! coldat newht)))
	 (hash-table-set! coldat rest run)))
     runs)
    data))

;; given ordered data hash return a-keys
;;
(define (pgdb:ordered-data->a-keys ordered-data)
  (sort (hash-table-keys ordered-data) string>=?))

;; given ordered data hash return b-keys
;;
(define (pgdb:ordered-data->b-keys ordered-data a-keys)
  (delete-duplicates
   (sort (apply
	  append
	  (map (lambda (sub-key)
		 (let ((subdat (hash-table-ref ordered-data sub-key)))
		   (hash-table-keys subdat)))
	       a-keys))
	 string>=?)))

(define (pgdb:runs-to-hash runs )
  (let* ((data  (make-hash-table)))
    (for-each
     (lambda (run)
       (let* ((run-name (vector-ref run 0))
	      (test (conc (vector-ref run 1) ":" (vector-ref run 3)))

           (s:p "  Result Format:   total / pass / fail / other")

	   (s:fieldset
	    (conc "Runs data for " tfilter)
	    ;;
	    ;; A very basic display
	    ;;
	    (let* ((a-keys (pgdb:ordered-data->a-keys ordered-data))



		   (b-keys (pgdb:ordered-data->b-keys ordered-data a-keys)))



	      ;; (c-keys (delete-duplicates b-keys)))
	      (if #f ;; swap rows/cols
		  (s:table
		   (s:tr (s:td "")(map s:tr b-keys))
		   (map
		    (lambda (row-key)
		      (let ((subdat (hash-table-ref ordered-data row-key)))
			(s:tr (s:td row-key)
			      (map
			       (lambda (col-key)
				 (s:td (let ((dat (hash-table-ref/default subdat col-key #f)))
					 (s:td (if dat
						   (list (vector-ref dat 0)(vector-ref dat 1))
						   "")))))
			       b-keys))))
		    a-keys))
		  
		  (s:table
		   (s:tr (s:td "")(map s:td a-keys))
		   (map
		    (lambda (row-key)
		      (s:tr (s:td row-key)
			    (map
			     (lambda (col-key)

   updating:             #f
   hide-not-hide-tabs:   #f
   ))

;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary)
;;
(define (dboard:common-get-tabdat commondat #!key (tab-num #f))
  (let* ((tnum (or tab-num
		   (dboard:commondat-curr-tab-num commondat)
		   0)) ;; tab-num value is curr-tab-num value in passed commondat
	 (ht   (dboard:commondat-tabdats commondat))
	 (res  (hash-table-ref/default ht tnum #f)))
    (or res
	(let ((new-tabdat  (dboard:tabdat-make-data)))
	  (hash-table-set! ht tnum new-tabdat)
	  new-tabdat))))

;; RA => sets the tabdat passed to the hashkey at commondat:tabdats hash table
;;
(define (dboard:common-set-tabdat! commondat tabnum tabdat)
  (hash-table-set!
   (dboard:commondat-tabdats commondat)
   tabnum

				      (lambda ()
					(handle-exceptions
					 exn
					 (begin
					   (print-call-chain)
					   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
					   (debug:print 0 *default-log-port* "ERROR: failed call procedure \"" updater
							"\", with; tabnum=" tab-num ", view-name=" view-name
							", and views-cfgdat and megatest configdat as parameters. To debug try loading in the repl: megatest -repl")
					   (set! success #f))
					 (debug:print 4 *default-log-port* "Running updater for tab " view-name " with proc " updater " and tab-num: " tab-num)
					 ((eval (string->symbol updater)) commondat tabs tab-num view-name views-cfgdat *configdat*)))
				      tab-num: tab-num))
    ;;(if success
    ;;	(begin
    ;;	  ;; (iup:attribute-set! tabs (conc "TABTITLE" tab-num) view-name)
    ;;	  (dboard:common-set-tabdat! commondat tab-num (dboard:tabdat-make-data))))
    result-child))



(define (dboard:runs-summary-buttons-updater tabdat)
  (let loop ((buttons-left (dboard:tabdat-runs-summary-mode-buttons tabdat))
             (modes-left (dboard:tabdat-runs-summary-modes tabdat)))