Megatest

Diff
Login

Differences From Artifact [647f8d5ef7]:

To Artifact [fe89207a20]:


100
101
102
103
104
105
106

107
108
109
110
111
112
113
			"-main"
			"-v"
			"-q"
			"-use-db-cache"
			"-skip-version-check"
			"-repl"
                        "-rh5.11" ;; fix to allow running on rh5.11

			)
		 args:arg-hash
		 0))

;; check for MT_* environment variables and exit if found
(if (not (args:get-arg "-test"))
    (begin







>







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
			"-main"
			"-v"
			"-q"
			"-use-db-cache"
			"-skip-version-check"
			"-repl"
                        "-rh5.11" ;; fix to allow running on rh5.11
			"-:p"     ;; ignore the built in chicken profiling switch
			)
		 args:arg-hash
		 0))

;; check for MT_* environment variables and exit if found
(if (not (args:get-arg "-test"))
    (begin
2929
2930
2931
2932
2933
2934
2935

2936

2937
2938
2939
2940
2941
2942
2943
2944
2945

2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
		    (result  '()))
		(for-each
		 (lambda (view-name)
		   (debug:print 0 *default-log-port* "Adding view " view-name)
		   (let* ((cfgtype (configf:lookup views-cfgdat view-name "type"))) ;; what type of view?
		     (if (not (string? cfgtype))
			 (debug:print-info 0 *default-log-port* "WARNING: view \"" view-name

				     "\" is missing needed sections. Please consult the documenation and update ~/.mtviews.config or " *toppath* "/.mtviews.config")

			 (case (string->symbol cfgtype)
			   ;; user supplied source for a tab
			   ;;
			   ((external)
			    (let ((tab-content (dboard:add-external-tab commondat view-name views-cfgdat #f tab-num))) ;; was tabs
			      (set! additional-tabnames (cons (cons tab-num view-name) additional-tabnames))
			      (set! tab-num (+ tab-num 1))
			      (set! result (append result (list tab-content)))))))))
		 (sort (hash-table-keys views-cfgdat) (lambda (a b)

							(let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999))
							      (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999)))
							  (> order-a order-b)))))
		result))
	     (tabs (apply iup:tabs
			  #:tabchangepos-cb (lambda (obj curr prev)
					      (debug:catch-and-dump
					       (lambda ()
						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
                   
						   (dboard:tabdat-layout-update-ok-set! tabdat #f))
						 (dboard:commondat-curr-tab-num-set! commondat curr)
						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
               
						   (dboard:commondat-please-update-set! commondat #t)
						   (dboard:tabdat-layout-update-ok-set! tabdat #t)))
					       "tabchangepos"))
			  (dashboard:summary commondat stats-dat tab-num: 0)
			  runs-view
			  (make-runs-view commondat runs2-dat 2)
			  (dashboard:runs-summary commondat onerun-dat tab-num: 3)







>
|
>



|
|



|
>
|
|
|







<




<







2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959

2960
2961
2962
2963

2964
2965
2966
2967
2968
2969
2970
		    (result  '()))
		(for-each
		 (lambda (view-name)
		   (debug:print 0 *default-log-port* "Adding view " view-name)
		   (let* ((cfgtype (configf:lookup views-cfgdat view-name "type"))) ;; what type of view?
		     (if (not (string? cfgtype))
			 (debug:print-info 0 *default-log-port* "WARNING: view \"" view-name
					   "\" is missing needed sections. "
					   "Please consult the documenation and update ~/.mtviews.config or "
					   *toppath* "/.mtviews.config")
			 (case (string->symbol cfgtype)
			   ;; user supplied source for a tab
			   ;;
			   ((external) ;; was tabs
			    (let ((tab-content (dboard:add-external-tab commondat view-name views-cfgdat #f tab-num)))
			      (set! additional-tabnames (cons (cons tab-num view-name) additional-tabnames))
			      (set! tab-num (+ tab-num 1))
			      (set! result (append result (list tab-content)))))))))
		 (sort (hash-table-keys views-cfgdat)
		       (lambda (a b)
			 (let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999))
			       (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999)))
			   (> order-a order-b)))))
		result))
	     (tabs (apply iup:tabs
			  #:tabchangepos-cb (lambda (obj curr prev)
					      (debug:catch-and-dump
					       (lambda ()
						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))

						   (dboard:tabdat-layout-update-ok-set! tabdat #f))
						 (dboard:commondat-curr-tab-num-set! commondat curr)
						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))

						   (dboard:commondat-please-update-set! commondat #t)
						   (dboard:tabdat-layout-update-ok-set! tabdat #t)))
					       "tabchangepos"))
			  (dashboard:summary commondat stats-dat tab-num: 0)
			  runs-view
			  (make-runs-view commondat runs2-dat 2)
			  (dashboard:runs-summary commondat onerun-dat tab-num: 3)
2991
2992
2993
2994
2995
2996
2997
2998

2999
3000
3001
3002
3003
3004
3005
	;; make the iup tabs object available (for changing color for example)
	(dboard:commondat-hide-not-hide-tabs-set! commondat tabs)
	;; now set up the tabdat lookup
	(dboard:common-set-tabdat! commondat 0 stats-dat)
	(dboard:common-set-tabdat! commondat 1 runs-dat)
	(dboard:common-set-tabdat! commondat 2 onerun-dat)
	(dboard:common-set-tabdat! commondat 3 runcontrols-dat)
	(dboard:common-set-tabdat! commondat 4 runtimes-dat)


	(iup:vbox
	 tabs
	 ;; controls
	 ))))
    (vector keycol lftcol header runsvec)))








|
>







2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
	;; make the iup tabs object available (for changing color for example)
	(dboard:commondat-hide-not-hide-tabs-set! commondat tabs)
	;; now set up the tabdat lookup
	(dboard:common-set-tabdat! commondat 0 stats-dat)
	(dboard:common-set-tabdat! commondat 1 runs-dat)
	(dboard:common-set-tabdat! commondat 2 onerun-dat)
	(dboard:common-set-tabdat! commondat 3 runcontrols-dat)
	(dboard:common-set-tabdat! commondat 4 runs2-dat)
	(dboard:common-set-tabdat! commondat 5 runtimes-dat)

	(iup:vbox
	 tabs
	 ;; controls
	 ))))
    (vector keycol lftcol header runsvec)))