Megatest

      )))

;;======================================================================
;; S U M M A R Y 
;;======================================================================
;;
;; General info about the run(s) and megatest area
(define (dashboard:summary alldat)
  (let* ((rawconfig        (read-config (conc *toppath* "/megatest.config") #f #f))) ;; changed to #f since I want #{} to be expanded by [system ...] to NOT be expanded. WAS: 'return-string)))
    (iup:vbox
     (iup:split
      #:value 500
      (iup:frame 
       #:title "General Info"
       (iup:vbox

       (iup:vbox
	(dcommon:section-matrix rawconfig "server" "Varname" "Value")
	;; (iup:frame
	;; #:title "Disks Areas"
	(dcommon:section-matrix rawconfig "disks" "Disk area" "Path"))))
     (iup:frame
      #:title "Run statistics"
      (dcommon:run-stats alldat)))))

;;======================================================================
;; R U N
;;======================================================================
;;
;; display and manage a single run at a time

	       " -runname " runname
	       " -testpatt " test-name
	       " -preclean -clean-cache"))))
     (iup:menu-item
      "Start xterm"
      #:action
      (lambda (obj)
	(let* ((cmd (conc (car (argv)) " -xterm " run-id "," test-id "&")))
	  (system cmd))))
     (iup:menu-item
      "Edit testconfig"
      #:action
      (lambda (obj)
	(let* ((all-tests (tests:get-all))
	       (editor-rx (or (configf:lookup *configdat* "setup" "editor-regex") 
			      "\\b(vim?|nano|pico)\\b"))
	       (editor (or (configf:lookup *configdat* "setup" "editor")
			   (get-environment-variable "VISUAL")
			   (get-environment-variable "EDITOR") "vi"))
	       (tconfig (conc (hash-table-ref all-tests test-name) "/testconfig"))
	       (cmd (conc (if (string-search editor-rx editor)
			      (conc "xterm -e " editor)
			      editor)
			  " " tconfig " &")))
	  (system cmd))))
     ))))

(define (make-dashboard-buttons alldat nruns ntests keynames runs-sum-dat new-view-dat)
  (let* ((nkeys   (length keynames))
	 (runsvec (make-vector nruns))
	 (header  (make-vector nruns))
	 (lftcol  (make-vector ntests))
	 (keycol  (make-vector ntests))
	 (controls '())
	 (lftlst  '())
	 (hdrlst  '())
	 (bdylst  '())
	 (result  '())
	 (i       0))
    ;; controls (along bottom)
    (set! controls (dboard:make-controls alldat))
    
    ;; create the left most column for the run key names and the test names 
    (set! lftlst (list (iup:hbox
			(iup:label) ;; (iup:valuator)
			(apply iup:vbox 
			       (map (lambda (x)		
				      (let ((res (iup:hbox #:expand "HORIZONTAL"
							   (iup:label x #:size "x15" #:fontsize "10" #:expand "HORIZONTAL")
							   (iup:textbox #:size "x15" #:fontsize "10" #:value "%" #:expand "HORIZONTAL"
									#:action (lambda (obj unk val)
										   (mark-for-update)
										   (update-search alldat x val))))))
					(set! i (+ i 1))
					res))
				    keynames)))))
    (let loop ((testnum  0)
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst (append lftlst (list (iup:hbox  #:expand "HORIZONTAL"
						     (iup:valuator #:valuechanged_cb (lambda (obj)
										       (let ((val (string->number (iup:attribute obj "VALUE")))
											     (oldmax  (string->number (iup:attribute obj "MAX")))
											     (newmax  (* 10 (length *alltestnamelst*))))
											 (dboard:alldat-please-update-set! alldat #t)
											 (dboard:alldat-start-test-offset-set! alldat (inexact->exact (round (/ val 10))))
											 (debug:print 6 *default-log-port* "(dboard:alldat-start-test-offset alldat) " (dboard:alldat-start-test-offset alldat) " val: " val " newmax: " newmax " oldmax: " oldmax)
											 (if (< val 10)
											     (iup:attribute-set! obj "MAX" newmax))
											 ))
								   #:expand "VERTICAL" 
								   #:orientation "VERTICAL"

	     ;; (data (dboard:alldat-init (make-d:data)))
	     (tabs (iup:tabs
		    #:tabchangepos-cb (lambda (obj curr prev)
					(dboard:alldat-please-update-set! alldat #t)
					(dboard:alldat-curr-tab-num-set! alldat curr))
		    (dashboard:summary alldat)
		    runs-view
		    (dashboard:one-run alldat runs-sum-dat)
		    ;; (dashboard:new-view db data new-view-dat)
		    (dashboard:run-controls alldat)
		    (dashboard:run-times alldat)
		    )))
	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
	(iup:attribute-set! tabs "TABTITLE0" "Summary")
	(iup:attribute-set! tabs "TABTITLE1" "Runs")

(define *monitor-db-path* #f)
(define *last-monitor-update-time* 0)

;; Force creation of the db in case it isn't already there.
(tasks:open-db)

(define (dashboard:get-youngest-run-db-mod-time alldat)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (apply max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:alldat-dbdir alldat) "/*.db"))))))

(define (dashboard:run-update x alldat)
  (let* ((modtime         (dashboard:get-youngest-run-db-mod-time alldat)) ;; (file-modification-time (dboard:alldat-dbfpath alldat)))
	 (monitor-modtime (if (file-exists? *monitor-db-path*)
			      (file-modification-time *monitor-db-path*)
			      -1))
	 (run-update-time (current-seconds))
	 (recalc          (dashboard:recalc modtime (dboard:alldat-please-update alldat) (dboard:alldat-last-db-update alldat))))
    (if (and (eq? (dboard:alldat-curr-tab-num alldat) 0)
	     (or (> monitor-modtime *last-monitor-update-time*)

      (load debugcontrolf)))

(define (main)
  (common:exit-on-version-changed)
  (let* ((runs-sum-dat (dboard:alldat-make-data)) ;; init (make-d:data))) ;; data for run-summary tab
	 (new-view-dat runs-sum-dat) ;; (dboard:alldat-make-data)) ;; init (make-d:data)))
	 (alldat       runs-sum-dat))
    (dboard:setup-alldat alldat)
    (dboard:setup-num-rows alldat)
    ;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
    ;; (dboard:alldat-last-db-update-set! alldat (file-modification-time (dboard:alldat-dbfpath alldat))) ;; (conc *toppath* "/db/main.db")))
    (set! *monitor-db-path* (conc (dboard:alldat-dbdir alldat) "/monitor.db"))
    (cond 
     ((args:get-arg "-run")
      (let ((runid (string->number (args:get-arg "-run"))))

				   (dboard:alldat-updating-set! alldat #f)
				   (mutex-unlock! (dboard:alldat-update-mutex alldat)))))
			   1))))
    
    (let ((th1 (make-thread (lambda ()
			      (thread-sleep! 1)
			      (dboard:alldat-please-update-set! alldat #t)
			      (dashboard:run-update 1 alldat)) "update buttons once"))
	  (th2 (make-thread iup:main-loop "Main loop")))
      (thread-start! th1)
      (thread-start! th2)
      (thread-join! th2))))

(main)