@@ -48,11 +48,10 @@ ;; (declare (uses dashboard-main)) (declare (uses mt)) (include "common_records.scm") (include "db_records.scm") -(include "run_records.scm") (include "task_records.scm") (include "megatest-version.scm") (include "megatest-fossil-hash.scm") (include "vg_records.scm") @@ -1829,37 +1828,10 @@ (define (new-tree-path->run-id rdat path) (if (not (null? path)) (hash-table-ref/default (dboard:rdat-path-run-ids tabdat) path #f) #f)) - -;; (define (dboard:get-tests-dat tabdat run-id last-update) -;; (let* ((access-mode (dboard:tabdat-access-mode tabdat)) -;; (tdat (if run-id (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run -;; run-id -;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") -;; (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)) ;; '() -;; (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)) ;; '() -;; #f #f ;; offset limit -;; (dboard:tabdat-hide-not-hide tabdat) ;; not-in -;; #f #f ;; sort-by sort-order -;; #f ;; get all? "id,testname,item_path,state,status,event_time,run_duration" ;; qryval -;; (if (dboard:tabdat-filters-changed tabdat) -;; 0 -;; last-update) -;; *dashboard-mode*) -;; '()))) ;; get 'em all -;; ;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id) -;; (sort tdat (lambda (a b) -;; (let* ((aval (vector-ref a 2)) -;; (bval (vector-ref b 2)) -;; (anum (string->number aval)) -;; (bnum (string->number bval))) -;; (if (and anum bnum) -;; (< anum bnum) -;; (string<= aval bval))))))) - (define (dashboard:safe-cadr-assoc name lst) (let ((res (assoc name lst))) (if (and res (> (length res) 1)) (cadr res) @@ -2307,11 +2279,10 @@ ;; Bummer - we dont have the global get/set api mapped in chicken ;; (let* ((modkeys (iup:global "MODKEYSTATE"))) ;; (BB> "modkeys="modkeys)) (debug:print-info 13 *default-log-port* "click-cb: obj="obj" lin="lin" col="col" status="status) - ;; status is corrupted on Brandon's home machine. will have to wait until after shutdown to see if it is still broken in PDX SLES (let* ((toolpath (car (argv))) (key (conc lin ":" col)) (test-id (hash-table-ref/default cell-lookup key -1)) (run-id (dboard:tabdat-curr-run-id tabdat)) (run-info (rmt:get-run-info run-id)) @@ -2473,17 +2444,10 @@ (mark-for-update tabdat)))) (default-cmd (car (list-ref *tests-sort-type-index* *tests-sort-reverse*)))) (iuplistbox-fill-list sort-lb cmds-list selected-item: default-cmd) - ;; (set! hide-empty (iup:button "HideEmpty" - ;; ;; #:expand HORIZONTAL" - ;; #:expand "NO" #:size "80x15" - ;; #:action (lambda (obj) - ;; (dboard:tabdat-hide-empty-runs-set! tabdat (not (dboard:tabdat-hide-empty-runs tabdat))) - ;; (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-empty-runs tabdat) "+HideE" "-HideE")) - ;; (mark-for-update tabdat)))) (set! hide (iup:button "Hide" #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL" #:action (lambda (obj) (dboard:tabdat-hide-not-hide-set! tabdat #t) ;; (not (dboard:tabdat-hide-not-hide tabdat))) ;; (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-not-hide tabdat) "HideTests" "NotHide")) @@ -2497,23 +2461,19 @@ (iup:attribute-set! show "BGCOLOR" sel-color) (iup:attribute-set! hide "BGCOLOR" nonsel-color) (mark-for-update tabdat)))) (iup:attribute-set! hide "BGCOLOR" sel-color) (iup:attribute-set! show "BGCOLOR" nonsel-color) - ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ... (iup:vbox (iup:hbox hide show) sort-lb))) ) ;; insert extra widget here (if extra-widget extra-widget (iup:hbox)) ;; empty widget - - - ))) (let* ((status-toggles (map (lambda (status) (iup:toggle (conc status) @@ -3036,11 +2996,10 @@ (or please-update-buttons (and ;; (> (current-milliseconds)(+ *last-recalc-ended-time* 150)) ;; can't use this - it needs to be tab specific (> modtime (- last-db-update-time 3)) ;; add three seconds of margin (> (current-seconds)(+ last-db-update-time 1))))) -;; (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) @@ -3259,26 +3218,13 @@ ;; (dboard:tabdat-allruns-set! tabdat '()) (dboard:tabdat-max-row-set! tabdat 0) (dboard:tabdat-last-filter-str-set! tabdat filtrstr))) (update-rundat tabdat runpatt - ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat) - testpatt ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") - ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%") - - targpatt - - ;; old method - ;; (let ((res '())) - ;; (for-each (lambda (key) - ;; (if (not (equal? key "runname")) - ;; (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f))) - ;; (if val (set! res (cons (list key val) res)))))) - ;; (dboard:tabdat-dbkeys tabdat)) - ;; res) - ))))) + testpatt + targpatt))))) ;; run times canvas updater ;; (define (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num) (let ((cnv (dboard:tabdat-cnv tabdat)) @@ -3293,16 +3239,10 @@ (canvas-clear! cnv) (vg:draw dwg tabdat) (mutex-unlock! mtx) (dboard:tabdat-view-changed-set! tabdat #f))))) -;; doesn't work. -;; -;;(define (gotoescape tabdat escape) -;; (or (dboard:tabdat-layout-update-ok tabdat) -;; (escape #t))) - (define (dboard:graph-db-open dbstr) (let* ((parts (string-split dbstr ":")) (dbpth (if (< (length parts) 2) ;; assume then a filename was provided dbstr (if (equal? (car parts) "sqlite3")