Megatest

Check-in [a8d45ad7dd]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Gui clean ups for Run Summary
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev | kind-db-access
Files: files | file ages | folders
SHA1: a8d45ad7dda876359e65055e2c04d36342feb02c
User & Date: matt on 2013-07-05 17:19:57
Other Links: branch diff | manifest | tags
Context
2013-07-06
14:29
Number of bug fixes to tree selectors, run summary etc. check-in: 20cf1d8e3f user: matt tags: dev, kind-db-access
2013-07-05
17:19
Gui clean ups for Run Summary check-in: a8d45ad7dd user: matt tags: dev, kind-db-access
16:25
Runs summary working nicely check-in: c76a0c089e user: matt tags: dev, kind-db-access
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [e0656ce8d9] to [ee415124e5].

︙
662
663
664
665
666
667
668
669


670
671
672
673
674
675
676

662
663
664
665
666
667
668

669
670
671
672
673
674
675
676
677








-
+
+








		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((run-path (tree:node->path obj id))
			    (run-id   (tree-path->run-id (cdr run-path))))
		       (if run-id
			   (begin
			     (dboard:data-set-curr-run-id! *data* run-id)
			     (dashboard:update-run-summary-tab)))
		       (print "path: " (tree:node->path obj id) " run-id: " run-id)))))
		       ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
		       ))))
	 (run-matrix (iup:matrix
		      #:expand "YES"))
	 (updater  (lambda ()
		     (let* ((runs-dat     (mt:get-runs-by-patt *keys* "%" #f))
			    (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
			    (run-id       (dboard:data-get-curr-run-id *data*))
			    (tests-dat    (let ((tdat (mt:get-tests-for-run run-id "%" '() '()
︙
720
721
722
723
724
725
726

727
728
729
730


731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751


752
753
754
755
756
757
758
759
760
761
762
763

721
722
723
724
725
726
727
728
729
730


731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752

753
754
755
756
757
758

759
760
761
762
763
764
765








+


-
-
+
+




















-
+
+




-








				     (let ((path ;;(string-intersperse "/" 
					    (append key-vals (list run-name))))
				       (hash-table-set! (dboard:data-get-path-run-ids *data*) path run-id))
				     ;; (set! colnum (+ colnum 1))
				     ))
				 run-ids)
		       (iup:attribute-set! run-matrix "CLEARVALUE" "CONTENTS")
		       (iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
		       (iup:attribute-set! run-matrix "NUMCOL" max-col )
		       (iup:attribute-set! run-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20
		       (iup:attribute-set! run-matrix "NUMCOL_VISIBLE" max-col)
		       (iup:attribute-set! run-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row))
		       ;; (iup:attribute-set! run-matrix "NUMCOL_VISIBLE" max-col)
		       ;; (iup:attribute-set! run-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row))
		       
		       ;; Row labels
		       (for-each (lambda (ind)
				   (let* ((name (car ind))
					  (num  (cadr ind))
					  (key  (conc num ":0")))
				     (if (not (equal? (iup:attribute run-matrix key) name))
					 (begin
					   (set! changed #t)
					   (iup:attribute-set! run-matrix key name)))))
				 row-indices)
		       
		       ;; Col labels
		       (for-each (lambda (ind)
				   (let* ((name (car ind))
					  (num  (cadr ind))
					  (key  (conc "0:" num)))
				     (if (not (equal? (iup:attribute run-matrix key) name))
					 (begin
					   (set! changed #t)
					   (iup:attribute-set! run-matrix key name)))))
					   (iup:attribute-set! run-matrix key name)
					   (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num))))))
				 col-indices)
		       
		       ;; Cell contents
		       (for-each (lambda (entry)
				   (debug:print-info 0 "entry=" entry)
				   (let* ((row-name  (cadr entry))
					  (col-name  (car entry))
					  (valuedat  (caddr entry))
					  (test-id   (list-ref valuedat 0))
					  (test-name row-name) ;; (list-ref valuedat 1))
					  (item-path col-name) ;; (list-ref valuedat 2))
					  (state     (list-ref valuedat 1))
︙
771
772
773
774
775
776
777
778

779
780
781
782
783
784
785

773
774
775
776
777
778
779

780
781
782
783
784
785
786
787








-
+








					   (set! changed #t)
					   (iup:attribute-set! run-matrix key (cadr value))
					   (iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
				 tests-mindat)
		       (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL"))))))
    (set! dashboard:update-run-summary-tab updater)
    (dboard:data-set-runs-tree! *data* tb)
    (iup:hbox 
    (iup:split
     tb
     run-matrix)))

;;======================================================================
;; R U N S 
;;======================================================================
︙

This page was generated in about 0.109s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00