Index: dashboard-tests-inc.scm ================================================================== --- dashboard-tests-inc.scm +++ dashboard-tests-inc.scm @@ -26,10 +26,16 @@ ;; C O M M O N ;;====================================================================== (define *dashboard-comment-share-slot* #f) +(define (message-window msg) + (iup:show + (iup:dialog + (iup:vbox + (iup:label msg #:margin "40x40"))))) + (define (dtests:get-pre-command #!key (default-override #f)) (let* ((orig-pre-command "export CMD='") (viewscreen-pre-command "viewscreen ") (use-viewscreen (configf:lookup *configdat* "dashboard" "use-viewscreen")) (default-pre-command (if use-viewscreen viewscreen-pre-command orig-pre-command)) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -474,11 +474,11 @@ status ;; test status ) ;; default is to NOT set the cell if the column and row names are not pre-existing ;; -(define (dboard:runsdat-set-test-cell dat target runname testname itempath test-id state status #!key (force-set #f)) +#;(define (dboard:runsdat-set-test-cell dat target runname testname itempath test-id state status #!key (force-set #f)) (let* ((col-num (dcommon:runsdat-get-col-num dat target runname force-set)) (row-num (dcommon:runsdat-get-row-num dat testname itempath force-set))) (if (and row-num col-num) (let ((tdat (dboard:testdat id: test-id @@ -535,16 +535,10 @@ (define-inline (dboard:uidat-get-header vec)(vector-ref vec 2)) (define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3)) (if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME"))) -(define (message-window msg) - (iup:show - (iup:dialog - (iup:vbox - (iup:label msg #:margin "40x40"))))) - (define (iuplistbox-fill-list lb items #!key (selected-item #f)) (let ((i 1)) (for-each (lambda (item) (iup:attribute-set! lb (number->string i) item) (if selected-item Index: db-inc.scm ================================================================== --- db-inc.scm +++ db-inc.scm @@ -1092,11 +1092,11 @@ (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id)) (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago"))) res)) ;; keeping it around for debugging purposes only -(define (open-run-close-no-exception-handling proc idb . params) +#;(define (open-run-close-no-exception-handling proc idb . params) (debug:print-info 11 *default-log-port* "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params) (print "I don't work anymore. open-run-close-no-exception-handling needs fixing or removing...") (exit) (if (or *db-write-access* (not #t)) ;; was: (member proc * db:all-write-procs *))) @@ -1111,11 +1111,11 @@ (if (not idb)(sqlite3:finalize! dbstruct)) (debug:print-info 11 *default-log-port* "open-run-close-no-exception-handling END" ) res) #f)) -(define (open-run-close-exception-handling proc idb . params) +#;(define (open-run-close-exception-handling proc idb . params) (handle-exceptions exn (let ((sleep-time (random 30)) (err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) (case err-status @@ -1131,11 +1131,11 @@ (debug:print-info 0 *default-log-port* "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up"))) (apply open-run-close-exception-handling proc idb params)) (apply open-run-close-no-exception-handling proc idb params))) ;; (define open-run-close -(define open-run-close open-run-close-exception-handling) +#;(define open-run-close open-run-close-exception-handling) ;; open-run-close-no-exception-handling ;; open-run-close-exception-handling) ;;) (define (db:initialize-main-db dbdat) @@ -1444,11 +1444,11 @@ db "SELECT id FROM archive_blocks WHERE archive_disk_id=? AND disk_path=?;" bdisk-id archive-path) (if res ;; record exists, update du if applicable and return res (begin - (if du (sqlite3:exectute db "UPDATE archive_blocks SET last_du=?,last_du_time=(strftime('%s','now')) + (if du (sqlite3:execute db "UPDATE archive_blocks SET last_du=?,last_du_time=(strftime('%s','now')) WHERE archive_disk_id=? AND disk_path=?;" bdisk-id archive-path du)) res) (begin (sqlite3:execute db "INSERT OR REPLACE INTO archive_blocks (archive_disk_id,disk_path,last_du) Index: dcommon-inc.scm ================================================================== --- dcommon-inc.scm +++ dcommon-inc.scm @@ -251,11 +251,11 @@ ;; (if changed (iup:attribute-set! (dboard:tabdat-runs-matrix data) "REDRAW" "ALL")) ;; ;; (debug:print 2 *default-log-port* "run-changes: " run-changes) ;; ;; (debug:print 2 *default-log-port* "test-changes: " test-changes) ;; (list run-changes all-test-changes))) -(define (dcommon:runsdat-get-col-num dat target runname force-set) +#;(define (dcommon:runsdat-get-col-num dat target runname force-set) (let* ((runs-index (dboard:runsdat-runs-index dat)) (col-name (conc target "/" runname)) (res (hash-table-ref/default runs-index col-name #f))) (if res res @@ -262,11 +262,11 @@ (if force-set (let ((max-col-num (+ 1 (common:max (cons-1 (hash-table-values runs-index)))))) (hash-table-set! runs-index col-name max-col-num) max-col-num))))) -(define (dcommon:runsdat-get-row-num dat testname itempath force-set) +#;(define (dcommon:runsdat-get-row-num dat testname itempath force-set) (let* ((tests-index (dboard:runsdat-runs-index dat)) (row-name (conc testname "/" itempath)) (res (hash-table-ref/default runs-index row-name #f))) (if res res Index: megamod.scm ================================================================== --- megamod.scm +++ megamod.scm @@ -17,38 +17,38 @@ ;; along with Megatest. If not, see . ;;====================================================================== (declare (unit megamod)) -(declare (uses commonmod)) -(declare (uses dbmod)) -;;(declare (uses apimod)) -(declare (uses ftail)) -;; (declare (uses rmtmod)) -(declare (uses commonmod)) -(declare (uses apimod)) -(declare (uses archivemod)) -(declare (uses clientmod)) -(declare (uses configfmod)) -(declare (uses dbmod)) -(declare (uses dcommonmod)) -(declare (uses envmod)) -(declare (uses ezstepsmod)) -(declare (uses itemsmod)) -(declare (uses keysmod)) -(declare (uses launchmod)) -(declare (uses odsmod)) -(declare (uses processmod)) -(declare (uses runconfigmod)) -(declare (uses runsmod)) -(declare (uses servermod)) -(declare (uses subrunmod)) -(declare (uses tasksmod)) -(declare (uses testsmod)) -(declare (uses vgmod)) - -(module rmtmod +;; (declare (uses commonmod)) +;; (declare (uses dbmod)) +;; ;;(declare (uses apimod)) +;; (declare (uses ftail)) +;; ;; (declare (uses rmtmod)) +;; (declare (uses commonmod)) +;; (declare (uses apimod)) +;; (declare (uses archivemod)) +;; (declare (uses clientmod)) +;; (declare (uses configfmod)) +;; (declare (uses dbmod)) +;; (declare (uses dcommonmod)) +;; (declare (uses envmod)) +;; (declare (uses ezstepsmod)) +;; (declare (uses itemsmod)) +;; (declare (uses keysmod)) +;; (declare (uses launchmod)) +;; (declare (uses odsmod)) +;; (declare (uses processmod)) +;; (declare (uses runconfigmod)) +;; (declare (uses runsmod)) +;; (declare (uses servermod)) +;; (declare (uses subrunmod)) +;; (declare (uses tasksmod)) +;; (declare (uses testsmod)) +;; (declare (uses vgmod)) + +(module megamod * (import scheme chicken data-structures extras) (import (prefix base64 base64:)