Megatest

    (let ((db #f)
	  (keys #f))
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 *default-log-port* "Failed to setup, exiting")
	    (exit 1)))
      (set! keys (rmt:get-keys)) ;;  db))
      (debug:print 1 *default-log-port* "Keys: " (string-intersperse keys ", "))
      (debug:print 0 *default-log-port* (string-intersperse keys " "))
      (if (sqlite3:database? db)(sqlite3:finalize! db))
      (set! *didsomething* #t)))

(if (args:get-arg "-gui")
    (begin
      (debug:print 0 *default-log-port* "Look at the dashboard for now")
      ;; (megatest-gui)
      (set! *didsomething* #t)))

;;======================================================================

;; (declare (uses common))
;; (declare (uses megatest-version))
(declare (uses mtargs))
(declare (uses treemod))

(use srfi-1
(use srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors)
(use format
     posix regex regex-case srfi-69 typed-records sparse-vectors
     format
     extras
     (prefix iup iup:)
     canvas-draw)

(import canvas-draw-iup)
;; (debug:setup)

(module ndboard
    *

(import scheme
	chicken
	data-structures
	extras
	format
	(prefix iup iup:)
	canvas-draw
	canvas-draw-iup
	matchable
	srfi-1 posix regex regex-case
	srfi-69 typed-records sparse-vectors ;; defstruct

;; areas
;;

(define *areas* (make-hash-table))
(defstruct area
  path
  keys
  targets
  targets-update-time
  )
  
  )

(define (area-get-path area-name)
  (let* ((adat (hash-table-ref/default *areas* area-name #f)))
    (if adat
	(area-path adat)
	#f)))

(define (get-areas-file)
  (conc (get-environment-variable "HOME")"/.ndboard/areas.scm"))

(define (get-areas)
  (let* ((areas-file (get-areas-file)))
    (if (file-exists? areas-file)
	(with-input-from-file areas-file read))))

(define (register-area areadat)
  (hash-table-set! *areas* (car areadat)
		   (make-area (cdr areadat))))
		   (make-area path: (cdr areadat))))

(define (get-area-info area-name)
  (hash-table-ref/default *areas* area-name #f))

;; megatest calls, run in "area"
;;

;; TODO store the last time the query was run
;; and clear cache based on timestamp on main.db
;;
(define (megatest-get-targets area-name)
  (let* ((ainfo   (get-area-info area-name))
	 (targets (area-targets ainfo)))
    (if targets
	targets
	(let* ((path (area-get-path area-name))
	       (raw-targs   (with-input-from-pipe
				(conc "megatest -list-targets -start-dir "path)
			      read-lines))
	       (clean-targs (filter (lambda (x)
				      (not (equal? x "default")))
				    raw-targs)))
	  (area-targets-set! ainfo clean-targs)
	  (area-targets-update-time-set! ainfo (current-seconds))
	  clean-targs))))

(define (megatest-get-keys area-name)
  (let* ((ainfo   (get-area-info area-name))
	 (keys    (area-keys ainfo)))
    (if keys
	keys
	(let* ((path     (area-path ainfo))
	       (keysstrs (with-input-from-pipe
			     (conc "megatest -show-keys -start-dir "path)
			   read-lines)))
	  (if (null? keysstrs)
	      (print "Unknown error getting keys for area "area-name", path: "path)
	      (let* ((keystr (car keysstrs))
		     (keys   (string-split keystr)))
		(area-keys-set! ainfo keys)
		keys))))))
	  
;; gui utils
;;

(define (message-window msg)
  (iup:show
   (iup:dialog
    (iup:vbox 
     (iup:label msg #:margin "40x40")))))

(define (iuplistbox-fill-list lb items . default)

   #:expand "YES"
   #:addexpanded "YES"
   #:size "10x"
   #:selection-cb
   (lambda (obj id state)
     (let* ((path (tree:node->path obj id)))
       (match path
	 ((treename)(print "nothing to do here"))
	 ((treename) #f) ;;(print "nothing to do here"))
	 ((treename area)

	  #f ;; read the megatest area targets and fill out the tree
	  ))
       
       (print "obj: "obj", id: "id", state: "state", path: "path)))))
	  (let ((tb (get-widget "main-tree")))
	    (refresh-targets tb area)))
	 ((treename area . target)
	  (print "area: "area", target: "target))
	 (else
	  (print "path: "path))
	  )
       #;(print "obj: "obj", id: "id", state: "state", path: "path)))))

(define (refresh-targets tb area)
  (let* ((targets (megatest-get-targets area)))
    (for-each
     (lambda (target)
       (let* ((t-path (string-split target "/")))
	 (tree:add-node tb "Areas" (cons area t-path))))
     targets)))

(define (runs window-id)
  (iup:hbox
   (add-widget "main-tree" (main-tree))
   ;;
   ))