72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
-
+
|
(if (not (launch:setup-for-run))
(begin
(print "Failed to find megatest.config, exiting")
(exit 1)))
;; (if (args:get-arg "-host")
;; (begin
;; (set! *runremote* (string-split (args:get-arg "-host" ":")))
;; (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;; (client:launch))
;; (client:launch))
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
|
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
|
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
|
-
+
-
-
+
|
(iup:attribute-set! tabtop "TABTITLE2" "Run Control")
(iup:attribute-set! tabtop "TABTITLE3" "megatest.config")
(iup:attribute-set! tabtop "TABTITLE4" "runconfigs.config")
tabtop)))
(define *current-window-id* 0)
(define (newdashboard dbstruct)
(define (newdashboard data)
(let* ((data (make-hash-table))
(keys (db:get-keys dbstruct))
(let* ((keys (db:get-keys dbstruct))
(runname "%")
(testpatt "%")
(keypatts (map (lambda (k)(list k "%")) keys))
(states '())
(statuses '())
(nextmintime (current-milliseconds))
(my-window-id *current-window-id*))
|
625
626
627
628
629
630
631
632
633
634
635
|
624
625
626
627
628
629
630
631
632
633
634
635
|
-
-
-
-
+
+
+
+
+
|
(if (< nextmintime (current-milliseconds))
(let* ((starttime (current-milliseconds))
(changes (dcommon:run-update keys data runname keypatts testpatt states statuses 'full my-window-id))
(endtime (current-milliseconds)))
(set! nextmintime (+ endtime (* 2 (- endtime starttime))))
(debug:print 11 "CHANGE(S): " (car changes) "..."))
(debug:print-info 11 "Server overloaded"))))))
(dboard:data-set-updaters! *data* (make-hash-table))
(newdashboard *dbstruct-local*)
(iup:main-loop)
;;; main
;;;
(let ((data (make-hash-table))) ;; data will have "areaname" => "area record" entries
(newdashboard data)
(iup:main-loop))
|