Artifact 10390e637308d06779d8b477c8e1cf0961358767:
- File dashboard-guimonitor.scm — part of check-in [b93e6887b8] at 2013-02-28 16:40:54 on branch trunk — Removed all traces of itempath (user: mrwellan size: 6656)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy 0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012, 0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland 0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p 0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a 0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t 00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi 00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr 00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a 00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file 00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det 00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th 0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di 0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU 0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY; 0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the 0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war 0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN 0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN 0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC 0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE 0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============ 01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;== 01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0220: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 69 6e 66 ====.;; Test inf 0230: 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d o panel.;;====== 0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0280: 0a 0a 28 75 73 65 20 66 6f 72 6d 61 74 29 0a 28 ..(use format).( 0290: 72 65 71 75 69 72 65 2d 6c 69 62 72 61 72 79 20 require-library 02a0: 69 75 70 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 iup).(import (pr 02b0: 65 66 69 78 20 69 75 70 20 69 75 70 3a 29 29 0a efix iup iup:)). 02c0: 0a 28 75 73 65 20 63 61 6e 76 61 73 2d 64 72 61 .(use canvas-dra 02d0: 77 29 0a 0a 28 75 73 65 20 73 71 6c 69 74 65 33 w)..(use sqlite3 02e0: 20 73 72 66 69 2d 31 20 70 6f 73 69 78 20 72 65 srfi-1 posix re 02f0: 67 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 73 gex regex-case s 0300: 72 66 69 2d 36 39 29 0a 28 69 6d 70 6f 72 74 20 rfi-69).(import 0310: 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 (prefix sqlite3 0320: 73 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 sqlite3:))..(dec 0330: 6c 61 72 65 20 28 75 6e 69 74 20 64 61 73 68 62 lare (unit dashb 0340: 6f 61 72 64 2d 67 75 69 6d 6f 6e 69 74 6f 72 29 oard-guimonitor) 0350: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses 0360: 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 common)).(decla 0370: 72 65 20 28 75 73 65 73 20 6b 65 79 73 29 29 0a re (uses keys)). 0380: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 (declare (uses d 0390: 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 b)).(declare (us 03a0: 65 73 20 74 61 73 6b 73 29 29 0a 0a 28 69 6e 63 es tasks))..(inc 03b0: 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 lude "common_rec 03c0: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl 03d0: 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e ude "db_records. 03e0: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include " 03f0: 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 run_records.scm" 0400: 29 0a 28 69 6e 63 6c 75 64 65 20 22 74 61 73 6b ).(include "task 0410: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm").. 0420: 28 64 65 66 69 6e 65 20 28 63 6f 6e 74 72 6f 6c (define (control 0430: 2d 70 61 6e 65 6c 20 64 62 20 74 64 62 20 6b 65 -panel db tdb ke 0440: 79 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 76 61 ys). (let* ((va 0450: 72 2d 70 61 72 61 6d 73 20 28 6d 61 6b 65 2d 68 r-params (make-h 0460: 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 72 ash-table)) ;; r 0470: 65 67 69 73 74 65 72 20 61 6c 6c 20 74 68 65 20 egister all the 0480: 77 69 64 67 65 74 73 20 68 65 72 65 20 66 6f 72 widgets here for 0490: 20 71 75 65 72 79 69 6e 67 20 6f 6e 20 72 75 6e querying on run 04a0: 2c 20 72 6f 6c 6c 75 70 2c 20 72 65 6d 6f 76 65 , rollup, remove 04b0: 3f 0a 09 20 28 6b 65 79 2d 70 61 72 61 6d 73 20 ?.. (key-params 04c0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table 04d0: 29 29 0a 09 20 28 6d 6f 6e 69 74 6f 72 64 61 74 )).. (monitordat 04e0: 20 27 28 29 29 20 3b 3b 20 6c 69 73 74 20 6f 66 '()) ;; list of 04f0: 20 6d 6f 6e 69 74 6f 72 20 72 65 63 6f 72 64 73 monitor records 0500: 0a 09 20 28 6b 65 79 65 6e 74 72 69 65 73 20 28 .. (keyentries ( 0510: 69 75 70 3a 66 72 61 6d 65 20 0a 09 09 20 20 20 iup:frame ... 0520: 20 20 20 23 3a 74 69 74 6c 65 20 22 4b 65 79 73 #:title "Keys 0530: 22 0a 09 09 20 20 20 20 20 20 28 61 70 70 6c 79 "... (apply 0540: 0a 09 09 20 20 20 20 20 20 20 69 75 70 3a 76 62 ... iup:vb 0550: 6f 78 0a 09 09 20 20 20 20 20 20 20 28 6d 61 70 ox... (map 0560: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 (lambda (key).. 0570: 09 09 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f .. (iup:hbo 0580: 78 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 76 65 x (iup:label (ve 0590: 63 74 6f 72 2d 72 65 66 20 6b 65 79 20 30 29 20 ctor-ref key 0) 05a0: 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 29 20 #:size "60x15") 05b0: 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ; #:expand "HORI 05c0: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 09 09 28 69 ZONTAL")......(i 05d0: 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 65 78 70 up:textbox #:exp 05e0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL" 05f0: 0a 09 09 09 09 09 09 20 20 20 20 20 23 3a 61 63 ....... #:ac 0600: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob 0610: 6a 20 61 20 76 61 6c 29 0a 09 09 09 09 09 09 09 j a val)........ 0620: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 .(hash-table-set 0630: 21 20 6b 65 79 2d 70 61 72 61 6d 73 20 28 76 65 ! key-params (ve 0640: 63 74 6f 72 2d 72 65 66 20 6b 65 79 20 30 29 20 ctor-ref key 0) 0650: 76 61 6c 29 29 29 29 29 0a 09 09 09 20 20 20 20 val))))).... 0660: 6b 65 79 73 29 29 29 29 0a 09 20 28 6f 74 68 65 keys)))).. (othe 0670: 72 76 61 72 73 20 20 28 69 75 70 3a 66 72 61 6d rvars (iup:fram 0680: 65 0a 09 09 20 20 20 20 20 20 23 3a 74 69 74 6c e... #:titl 0690: 65 20 22 52 75 6e 20 56 61 72 73 22 0a 09 09 20 e "Run Vars"... 06a0: 20 20 20 20 20 28 61 70 70 6c 79 0a 09 09 20 20 (apply... 06b0: 20 20 20 20 20 69 75 70 3a 76 62 6f 78 0a 09 09 iup:vbox... 06c0: 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d (map (lam 06d0: 62 64 61 20 28 76 61 72 29 0a 09 09 09 20 20 20 bda (var).... 06e0: 20 20 20 28 69 75 70 3a 68 62 6f 78 20 28 69 75 (iup:hbox (iu 06f0: 70 3a 6c 61 62 65 6c 20 76 61 72 20 23 3a 73 69 p:label var #:si 0700: 7a 65 20 22 36 30 78 31 35 22 29 0a 09 09 09 09 ze "60x15")..... 0710: 09 28 69 75 70 3a 74 65 78 74 62 6f 78 20 20 20 .(iup:textbox 0720: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO 0730: 4e 54 41 4c 22 0a 09 09 09 09 09 09 20 20 20 20 NTAL"....... 0740: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam 0750: 62 64 61 20 28 6f 62 6a 20 61 20 76 61 6c 29 0a bda (obj a val). 0760: 09 09 09 09 09 09 09 09 20 20 28 68 61 73 68 2d ........ (hash- 0770: 74 61 62 6c 65 2d 73 65 74 21 20 76 61 72 2d 70 table-set! var-p 0780: 61 72 61 6d 73 20 76 61 72 20 76 61 6c 29 29 29 arams var val))) 0790: 29 29 0a 09 09 09 20 20 20 20 28 6c 69 73 74 20 )).... (list 07a0: 22 72 75 6e 6e 61 6d 65 22 20 22 74 65 73 74 70 "runname" "testp 07b0: 61 74 74 73 22 20 22 70 61 72 61 6d 73 22 29 29 atts" "params")) 07c0: 29 29 29 0a 09 20 28 63 6f 6e 74 72 6f 6c 73 20 ))).. (controls 07d0: 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 09 20 (iup:frame... 07e0: 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 43 6f #:title "Co 07f0: 6e 74 72 6f 6c 73 22 0a 09 09 20 20 20 20 20 20 ntrols"... 0800: 28 69 75 70 3a 68 62 6f 78 20 0a 09 09 20 20 20 (iup:hbox ... 0810: 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 (iup:frame.. 0820: 09 09 23 3a 74 69 74 6c 65 20 22 52 75 6e 73 22 ..#:title "Runs" 0830: 0a 09 09 09 28 69 75 70 3a 68 62 6f 78 20 0a 09 ....(iup:hbox .. 0840: 09 09 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 .. (iup:button " 0850: 53 74 61 72 74 22 20 20 0a 09 09 09 09 20 20 20 Start" ..... 0860: 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 #:expand "HORI 0870: 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 ZONTAL"..... 0880: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd 0890: 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 28 74 a (obj).......(t 08a0: 61 73 6b 73 3a 61 64 64 2d 66 72 6f 6d 2d 70 61 asks:add-from-pa 08b0: 72 61 6d 73 20 74 64 62 20 22 72 75 6e 22 20 6b rams tdb "run" k 08c0: 65 79 73 20 6b 65 79 2d 70 61 72 61 6d 73 20 76 eys key-params v 08d0: 61 72 2d 70 61 72 61 6d 73 29 0a 09 09 09 09 09 ar-params)...... 08e0: 09 28 70 72 69 6e 74 20 22 4c 61 75 6e 63 68 20 .(print "Launch 08f0: 52 75 6e 22 29 29 29 0a 09 09 09 20 28 69 75 70 Run"))).... (iup 0900: 3a 62 75 74 74 6f 6e 20 22 52 65 6d 6f 76 65 22 :button "Remove" 0910: 20 0a 09 09 09 09 20 20 20 20 20 23 3a 65 78 70 ..... #:exp 0920: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL" 0930: 0a 09 09 09 09 20 20 20 20 20 23 3a 61 63 74 69 ..... #:acti 0940: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj) 0950: 0a 09 09 09 09 09 09 28 70 72 69 6e 74 20 22 52 .......(print "R 0960: 65 6d 6f 76 65 20 52 75 6e 22 29 0a 09 09 09 09 emove Run")..... 0970: 09 09 28 74 61 73 6b 73 3a 61 64 64 2d 66 72 6f ..(tasks:add-fro 0980: 6d 2d 70 61 72 61 6d 73 20 74 64 62 20 22 72 65 m-params tdb "re 0990: 6d 6f 76 65 22 20 6b 65 79 73 20 6b 65 79 2d 70 move" keys key-p 09a0: 61 72 61 6d 73 20 76 61 72 2d 70 61 72 61 6d 73 arams var-params 09b0: 29 0a 09 09 09 09 09 09 29 29 0a 09 09 09 20 28 ).......)).... ( 09c0: 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 6f 6c 6c iup:button "Roll 09d0: 75 70 22 20 0a 09 09 09 09 20 20 20 20 20 23 3a up" ..... #: 09e0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 09f0: 41 4c 22 0a 09 09 09 09 20 20 20 20 20 23 3a 61 AL"..... #:a 0a00: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o 0a10: 62 6a 29 0a 09 09 09 09 09 09 28 70 72 69 6e 74 bj).......(print 0a20: 20 22 52 6f 6c 6c 75 70 20 52 75 6e 22 29 0a 09 "Rollup Run").. 0a30: 09 09 09 09 09 28 74 61 73 6b 73 3a 61 64 64 2d .....(tasks:add- 0a40: 66 72 6f 6d 2d 70 61 72 61 6d 73 20 74 64 62 20 from-params tdb 0a50: 22 72 6f 6c 6c 75 70 22 20 6b 65 79 73 20 6b 65 "rollup" keys ke 0a60: 79 2d 70 61 72 61 6d 73 20 76 61 72 2d 70 61 72 y-params var-par 0a70: 61 6d 73 29 29 29 29 29 0a 09 09 20 20 20 20 20 ams)))))... 0a80: 20 20 28 69 75 70 3a 66 72 61 6d 65 20 0a 09 09 (iup:frame ... 0a90: 09 23 3a 74 69 74 6c 65 20 22 4d 69 73 63 22 0a .#:title "Misc". 0aa0: 09 09 09 28 69 75 70 3a 68 62 6f 78 0a 09 09 09 ...(iup:hbox.... 0ab0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 51 75 (iup:button "Qu 0ac0: 69 74 22 20 0a 09 09 09 09 20 20 20 20 20 23 3a it" ..... #: 0ad0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 0ae0: 41 4c 22 0a 09 09 09 09 20 20 20 20 20 23 3a 61 AL"..... #:a 0af0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o 0b00: 62 6a 29 0a 09 09 09 09 09 09 28 73 71 6c 69 74 bj).......(sqlit 0b10: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db) 0b20: 0a 09 09 09 09 09 09 28 73 71 6c 69 74 65 33 3a .......(sqlite3: 0b30: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb).. 0b40: 09 09 09 09 09 28 65 78 69 74 29 29 29 29 29 29 .....(exit)))))) 0b50: 29 29 0a 09 20 28 6d 6f 6e 69 74 6f 72 73 20 20 )).. (monitors 0b60: 20 20 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 (iup:textbox 0b70: 0a 09 09 09 23 3a 65 78 70 61 6e 64 20 22 59 45 ....#:expand "YE 0b80: 53 22 20 3b 20 48 4f 52 49 5a 4f 4e 54 41 4c 22 S" ; HORIZONTAL" 0b90: 0a 09 09 09 3b 20 23 3a 73 69 7a 65 20 20 20 22 ....; #:size " 0ba0: 78 34 30 22 0a 09 09 09 23 3a 6d 75 6c 74 69 6c x40"....#:multil 0bb0: 69 6e 65 20 22 59 45 53 22 0a 09 09 09 23 3a 66 ine "YES"....#:f 0bc0: 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 ont "Courier New 0bd0: 2c 20 2d 31 30 22 0a 09 09 09 23 3a 76 61 6c 75 , -10"....#:valu 0be0: 65 20 22 4e 6f 6e 65 2e 2e 2e 2e 2e 2e 2e 2e 2e e "None......... 0bf0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 0c00: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 0c10: 2e 2e 2e 2e 2e 2e 22 29 29 0a 09 20 28 61 63 74 ......")).. (act 0c20: 69 6f 6e 73 20 20 20 20 20 20 28 69 75 70 3a 74 ions (iup:t 0c30: 65 78 74 62 6f 78 0a 09 09 09 23 3a 65 78 70 61 extbox....#:expa 0c40: 6e 64 20 22 59 45 53 22 0a 09 09 09 23 3a 6d 75 nd "YES"....#:mu 0c50: 6c 74 69 6c 69 6e 65 20 22 59 45 53 22 0a 09 09 ltiline "YES"... 0c60: 09 23 3a 66 6f 6e 74 20 22 43 6f 75 72 69 65 72 .#:font "Courier 0c70: 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 09 23 3a New, -10"....#: 0c80: 76 61 6c 75 65 20 22 4e 6f 6e 65 2e 2e 2e 2e 2e value "None..... 0c90: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 0ca0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 0cb0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 22 29 29 0a 09 20 ..........")).. 0cc0: 28 6c 61 73 74 6d 6f 64 74 69 6d 65 20 30 29 0a (lastmodtime 0). 0cd0: 09 20 28 6e 65 78 74 2d 74 6f 75 63 68 20 20 30 . (next-touch 0 0ce0: 29 20 3b 3b 20 74 68 65 20 6c 61 73 74 20 74 69 ) ;; the last ti 0cf0: 6d 65 20 74 68 65 20 22 6c 61 73 74 5f 75 70 64 me the "last_upd 0d00: 61 74 65 22 20 66 69 65 6c 64 20 77 61 73 20 75 ate" field was u 0d10: 70 64 61 74 65 64 0a 09 20 28 72 65 66 72 65 73 pdated.. (refres 0d20: 68 64 61 74 20 28 6c 61 6d 62 64 61 20 28 29 0a hdat (lambda (). 0d30: 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 .. (let* ( 0d40: 28 6d 6f 6e 69 74 6f 72 64 62 70 61 74 68 20 20 (monitordbpath 0d50: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath* 0d60: 22 2f 6d 6f 6e 69 74 6f 72 2e 64 62 22 29 29 0a "/monitor.db")). 0d70: 09 09 09 20 20 20 20 20 20 28 6d 65 67 61 74 65 ... (megate 0d80: 73 74 64 62 70 61 74 68 20 28 63 6f 6e 63 20 2a stdbpath (conc * 0d90: 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 toppath* "/megat 0da0: 65 73 74 2e 64 62 22 29 29 0a 09 09 09 20 20 20 est.db")).... 0db0: 20 20 20 28 6d 6f 64 74 69 6d 65 20 20 20 20 20 (modtime 0dc0: 20 20 20 28 6d 61 78 20 28 66 69 6c 65 2d 6d 6f (max (file-mo 0dd0: 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 dification-time 0de0: 6d 65 67 61 74 65 73 74 64 62 70 61 74 68 29 0a megatestdbpath). 0df0: 09 09 09 09 09 09 20 20 20 28 66 69 6c 65 2d 6d ...... (file-m 0e00: 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 odification-time 0e10: 20 6d 6f 6e 69 74 6f 72 64 62 70 61 74 68 29 29 monitordbpath)) 0e20: 29 29 0a 09 09 09 20 3b 3b 20 64 6f 20 73 74 75 )).... ;; do stu 0e30: 66 66 20 68 65 72 65 20 77 68 65 6e 20 74 68 65 ff here when the 0e40: 20 64 62 20 69 73 20 75 70 64 61 74 65 64 20 62 db is updated b 0e50: 79 20 73 6f 6d 65 20 6f 74 68 65 72 20 70 72 6f y some other pro 0e60: 63 65 73 73 0a 09 09 09 20 28 69 66 20 28 3e 20 cess.... (if (> 0e70: 6d 6f 64 74 69 6d 65 20 6c 61 73 74 6d 6f 64 74 modtime lastmodt 0e80: 69 6d 65 29 0a 09 09 09 20 20 20 20 20 28 6c 65 ime).... (le 0e90: 74 20 28 28 74 6c 73 74 20 28 74 61 73 6b 73 3a t ((tlst (tasks: 0ea0: 67 65 74 2d 74 61 73 6b 73 20 74 64 62 20 27 28 get-tasks tdb '( 0eb0: 29 20 27 28 29 29 29 0a 09 09 09 09 20 20 20 28 ) '()))..... ( 0ec0: 6d 6c 73 74 20 28 74 61 73 6b 73 3a 67 65 74 2d mlst (tasks:get- 0ed0: 6d 6f 6e 69 74 6f 72 73 20 74 64 62 29 29 29 0a monitors tdb))). 0ee0: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set! 0ef0: 74 61 73 6b 73 64 61 74 20 74 6c 73 74 29 0a 09 tasksdat tlst).. 0f00: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6d .. (set! m 0f10: 6f 6e 69 74 6f 72 73 64 61 74 20 6d 6c 73 74 29 onitorsdat mlst) 0f20: 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a .... (iup: 0f30: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6d attribute-set! m 0f40: 6f 6e 69 74 6f 72 73 20 22 56 41 4c 55 45 22 20 onitors "VALUE" 0f50: 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 73 2d (tasks:monitors- 0f60: 3e 74 65 78 74 2d 74 61 62 6c 65 20 6d 6c 73 74 >text-table mlst 0f70: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 )).... (iu 0f80: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set! 0f90: 20 61 63 74 69 6f 6e 73 20 20 22 56 41 4c 55 45 actions "VALUE 0fa0: 22 20 28 74 61 73 6b 73 3a 74 61 73 6b 73 2d 3e " (tasks:tasks-> 0fb0: 74 65 78 74 20 74 6c 73 74 29 29 0a 09 09 09 20 text tlst)).... 0fc0: 20 20 20 20 20 20 28 74 61 73 6b 73 3a 70 72 6f (tasks:pro 0fd0: 63 65 73 73 2d 71 75 65 75 65 20 64 62 20 74 64 cess-queue db td 0fe0: 62 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 b).... (se 0ff0: 74 21 20 6c 61 73 74 6d 6f 64 74 69 6d 65 20 28 t! lastmodtime ( 1000: 6d 61 78 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 max (file-modifi 1010: 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6d 65 67 61 cation-time mega 1020: 74 65 73 74 64 62 70 61 74 68 29 0a 09 09 09 09 testdbpath)..... 1030: 09 09 20 20 20 20 20 20 28 66 69 6c 65 2d 6d 6f .. (file-mo 1040: 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 dification-time 1050: 6d 6f 6e 69 74 6f 72 64 62 70 61 74 68 29 29 29 monitordbpath))) 1060: 0a 09 09 09 20 20 20 20 20 20 20 28 74 61 73 6b .... (task 1070: 73 3a 72 65 73 65 74 2d 73 74 75 63 6b 2d 74 61 s:reset-stuck-ta 1080: 73 6b 73 20 74 64 62 29 29 29 0a 09 09 09 20 3b sks tdb))).... ; 1090: 3b 20 73 74 75 66 66 20 74 6f 20 64 6f 20 65 76 ; stuff to do ev 10a0: 65 72 79 20 31 30 20 73 65 63 6f 6e 64 73 0a 09 ery 10 seconds.. 10b0: 09 09 20 28 69 66 20 28 3e 20 28 63 75 72 72 65 .. (if (> (curre 10c0: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 6e 65 78 74 nt-seconds) next 10d0: 2d 74 6f 75 63 68 29 0a 09 09 09 20 20 20 20 20 -touch).... 10e0: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 (begin.... 10f0: 20 3b 3b 20 28 74 61 73 6b 73 3a 70 72 6f 63 65 ;; (tasks:proce 1100: 73 73 2d 71 75 65 75 65 20 64 62 20 74 64 62 20 ss-queue db tdb 1110: 6d 6f 6e 69 74 6f 72 64 62 70 61 74 68 29 0a 09 monitordbpath).. 1120: 09 09 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a .. (tasks: 1130: 6d 6f 6e 69 74 6f 72 73 2d 75 70 64 61 74 65 20 monitors-update 1140: 74 64 62 29 0a 09 09 09 20 20 20 20 20 20 20 28 tdb).... ( 1150: 74 61 73 6b 73 3a 72 65 73 65 74 2d 73 74 75 63 tasks:reset-stuc 1160: 6b 2d 74 61 73 6b 73 20 74 64 62 29 0a 09 09 09 k-tasks tdb).... 1170: 20 20 20 20 20 20 20 28 73 65 74 21 20 6d 6f 6e (set! mon 1180: 69 74 6f 72 73 64 61 74 20 28 74 61 73 6b 73 3a itorsdat (tasks: 1190: 67 65 74 2d 6d 6f 6e 69 74 6f 72 73 20 74 64 62 get-monitors tdb 11a0: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 )).... (se 11b0: 74 21 20 6e 65 78 74 2d 74 6f 75 63 68 20 28 2b t! next-touch (+ 11c0: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second 11d0: 73 29 20 31 30 29 29 0a 09 09 09 20 20 20 20 20 s) 10)).... 11e0: 20 20 29 29 29 29 29 0a 09 20 28 74 6f 70 64 69 ))))).. (topdi 11f0: 61 6c 6f 67 20 20 23 66 29 29 0a 20 20 20 20 28 alog #f)). ( 1200: 73 65 74 21 20 74 6f 70 64 69 61 6c 6f 67 20 28 set! topdialog ( 1210: 69 75 70 3a 64 69 61 6c 6f 67 20 0a 09 09 20 20 iup:dialog ... 1220: 20 20 20 23 3a 63 6c 6f 73 65 5f 63 62 20 28 6c #:close_cb (l 1230: 61 6d 62 64 61 20 28 61 29 28 65 78 69 74 29 29 ambda (a)(exit)) 1240: 0a 09 09 20 20 20 20 20 23 3a 74 69 74 6c 65 20 ... #:title 1250: 22 52 75 6e 20 43 6f 6e 74 72 6f 6c 73 22 0a 09 "Run Controls".. 1260: 09 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a . (iup:vbox. 1270: 09 09 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f .. (iup:hbo 1280: 78 20 6b 65 79 65 6e 74 72 69 65 73 20 6f 74 68 x keyentries oth 1290: 65 72 76 61 72 73 29 0a 09 09 20 20 20 20 20 20 ervars)... 12a0: 63 6f 6e 74 72 6f 6c 73 0a 09 09 20 20 20 20 20 controls... 12b0: 20 28 6c 65 74 20 28 28 74 61 62 74 6f 70 20 28 (let ((tabtop ( 12c0: 69 75 70 3a 74 61 62 73 20 0a 09 09 09 09 20 20 iup:tabs ..... 12d0: 20 20 20 28 69 75 70 3a 76 62 6f 78 20 0a 09 09 (iup:vbox ... 12e0: 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 .. (let* ( 12f0: 28 74 62 20 28 69 75 70 3a 74 65 78 74 62 6f 78 (tb (iup:textbox 1300: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 1310: 4f 4e 54 41 4c 22 29 29 0a 09 09 09 09 09 20 20 ONTAL"))...... 1320: 20 20 20 20 28 62 74 20 28 69 75 70 3a 62 75 74 (bt (iup:but 1330: 74 6f 6e 20 22 52 65 6d 6f 76 65 20 74 61 73 6b ton "Remove task 1340: 73 20 62 79 20 69 64 22 0a 09 09 09 09 09 09 09 s by id"........ 1350: 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 #:action ( 1360: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj).... 1370: 09 09 09 09 09 09 20 28 6c 65 74 20 28 28 76 61 ...... (let ((va 1380: 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 l (iup:attribute 1390: 20 74 62 20 22 56 41 4c 55 45 22 29 29 29 0a 09 tb "VALUE"))).. 13a0: 09 09 09 09 09 09 09 09 20 20 20 28 74 61 73 6b ........ (task 13b0: 73 3a 72 65 6d 6f 76 65 2d 71 75 65 75 65 2d 65 s:remove-queue-e 13c0: 6e 74 72 69 65 73 20 74 64 62 20 76 61 6c 29 29 ntries tdb val)) 13d0: 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 )))...... ( 13e0: 6c 62 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 28 lb (iup:label "( 13f0: 63 6f 6d 6d 61 20 73 65 70 61 72 61 74 65 64 29 comma separated) 1400: 22 29 29 29 0a 09 09 09 09 09 20 28 69 75 70 3a ")))...... (iup: 1410: 68 62 6f 78 20 62 74 20 74 62 20 6c 62 29 29 0a hbox bt tb lb)). 1420: 09 09 09 09 20 20 20 20 20 20 20 61 63 74 69 6f .... actio 1430: 6e 73 29 0a 09 09 09 09 20 20 20 20 20 6d 6f 6e ns)..... mon 1440: 69 74 6f 72 73 0a 09 09 09 09 20 20 20 20 20 29 itors..... ) 1450: 29 29 0a 09 09 09 28 69 75 70 3a 61 74 74 72 69 ))....(iup:attri 1460: 62 75 74 65 2d 73 65 74 21 20 74 61 62 74 6f 70 bute-set! tabtop 1470: 20 22 54 41 42 54 49 54 4c 45 30 22 20 22 41 63 "TABTITLE0" "Ac 1480: 74 69 6f 6e 73 22 29 0a 09 09 09 28 69 75 70 3a tions")....(iup: 1490: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 attribute-set! t 14a0: 61 62 74 6f 70 20 22 54 41 42 54 49 54 4c 45 31 abtop "TABTITLE1 14b0: 22 20 22 4d 6f 6e 69 74 6f 72 73 22 29 0a 09 09 " "Monitors")... 14c0: 09 74 61 62 74 6f 70 29 0a 09 09 20 20 20 20 20 .tabtop)... 14d0: 20 29 29 29 0a 09 09 20 20 20 20 20 20 3b 20 28 )))... ; ( 14e0: 69 75 70 3a 66 72 61 6d 65 0a 09 09 20 20 20 20 iup:frame... 14f0: 20 20 3b 20 20 23 3a 74 69 74 6c 65 20 22 4d 6f ; #:title "Mo 1500: 6e 69 74 6f 72 73 22 0a 09 09 20 20 20 20 20 20 nitors"... 1510: 3b 20 20 6d 6f 6e 69 74 6f 72 73 29 0a 09 09 20 ; monitors)... 1520: 20 20 20 20 20 3b 20 28 69 75 70 3a 66 72 61 6d ; (iup:fram 1530: 65 0a 09 09 20 20 20 20 20 20 3b 20 20 23 3a 74 e... ; #:t 1540: 69 74 6c 65 20 22 41 63 74 69 6f 6e 73 22 0a 09 itle "Actions".. 1550: 09 20 20 20 20 20 20 3b 20 20 61 63 74 69 6f 6e . ; action 1560: 73 29 29 29 29 0a 0a 20 20 20 20 28 69 75 70 3a s)))).. (iup: 1570: 73 68 6f 77 20 74 6f 70 64 69 61 6c 6f 67 29 0a show topdialog). 1580: 20 20 20 20 28 69 75 70 3a 63 61 6c 6c 62 61 63 (iup:callbac 1590: 6b 2d 73 65 74 21 20 2a 74 69 6d 2a 20 22 41 43 k-set! *tim* "AC 15a0: 54 49 4f 4e 5f 43 42 22 0a 09 09 20 20 20 20 20 TION_CB"... 15b0: 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 (lambda (x)... 15c0: 09 20 28 72 65 66 72 65 73 68 64 61 74 29 0a 09 . (refreshdat).. 15d0: 09 09 20 28 69 66 20 2a 65 78 69 74 2d 73 74 61 .. (if *exit-sta 15e0: 72 74 65 64 2a 0a 09 09 09 20 20 20 20 20 28 73 rted*.... (s 15f0: 65 74 21 20 2a 65 78 69 74 2d 73 74 61 72 74 65 et! *exit-starte 1600: 64 2a 20 27 6f 6b 29 29 29 29 29 29 0a 0a 28 64 d* 'ok))))))..(d 1610: 65 66 69 6e 65 20 28 6d 61 69 6e 2d 77 69 6e 64 efine (main-wind 1620: 6f 77 20 73 65 74 75 70 74 61 62 20 66 73 6c 74 ow setuptab fslt 1630: 61 62 20 63 6f 6c 6c 61 74 65 72 61 6c 74 61 62 ab collateraltab 1640: 20 74 6f 6f 6c 73 74 61 62 29 0a 20 20 28 69 75 toolstab). (iu 1650: 70 3a 73 68 6f 77 0a 20 20 20 28 69 75 70 3a 64 p:show. (iup:d 1660: 69 61 6c 6f 67 20 23 3a 74 69 74 6c 65 20 22 46 ialog #:title "F 1670: 53 4c 20 50 6f 77 65 72 20 57 69 6e 64 6f 77 22 SL Power Window" 1680: 20 23 3a 73 69 7a 65 20 22 32 39 30 78 31 39 30 #:size "290x190 1690: 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 " ; #:expand "YE 16a0: 53 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 S". 16b0: 20 20 28 6c 65 74 20 28 28 74 61 62 74 6f 70 20 (let ((tabtop 16c0: 28 69 75 70 3a 74 61 62 73 20 73 65 74 75 70 74 (iup:tabs setupt 16d0: 61 62 20 63 6f 6c 6c 61 74 65 72 61 6c 74 61 62 ab collateraltab 16e0: 20 66 73 6c 74 61 62 20 74 6f 6f 6c 73 74 61 62 fsltab toolstab 16f0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))). 1700: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib 1710: 75 74 65 2d 73 65 74 21 20 74 61 62 74 6f 70 20 ute-set! tabtop 1720: 22 54 41 42 54 49 54 4c 45 30 22 20 22 53 65 74 "TABTITLE0" "Set 1730: 75 70 22 29 20 0a 20 20 20 20 20 20 20 20 20 20 up") . 1740: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr 1750: 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 74 6f ibute-set! tabto 1760: 70 20 22 54 41 42 54 49 54 4c 45 31 22 20 22 43 p "TABTITLE1" "C 1770: 6f 6c 6c 61 74 65 72 61 6c 22 29 0a 20 20 20 20 ollateral"). 1780: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 75 (iu 1790: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set! 17a0: 20 74 61 62 74 6f 70 20 22 54 41 42 54 49 54 4c tabtop "TABTITL 17b0: 45 32 22 20 22 46 6f 73 73 69 6c 22 29 0a 20 20 E2" "Fossil"). 17c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 17d0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 17e0: 74 21 20 74 61 62 74 6f 70 20 22 54 41 42 54 49 t! tabtop "TABTI 17f0: 54 4c 45 33 22 20 22 54 6f 6f 6c 73 22 29 0a 20 TLE3" "Tools"). 1800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1810: 74 61 62 74 6f 70 29 29 29 29 0a 0a 3b 3b 20 42 tabtop))))..;; B 1820: 55 47 3a 20 52 65 6d 65 6d 62 65 72 20 74 6f 20 UG: Remember to 1830: 72 65 2d 69 6e 73 74 61 74 65 20 74 68 69 73 21 re-instate this! 1840: 21 21 21 0a 3b 3b 20 28 6f 6e 2d 65 78 69 74 20 !!!.;; (on-exit 1850: 28 6c 61 6d 62 64 61 20 28 29 0a 3b 3b 20 09 20 (lambda ().;; . 1860: 20 20 28 6c 65 74 20 28 28 74 64 62 20 28 74 61 (let ((tdb (ta 1870: 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 29 0a 3b sks:open-db))).; 1880: 3b 20 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ; . ;; (prin 1890: 74 20 22 4f 6e 2d 65 78 69 74 20 63 61 6c 6c 65 t "On-exit calle 18a0: 64 22 29 0a 3b 3b 20 09 20 20 20 20 20 28 74 61 d").;; . (ta 18b0: 73 6b 73 3a 72 65 6d 6f 76 65 2d 6d 6f 6e 69 74 sks:remove-monit 18c0: 6f 72 2d 72 65 63 6f 72 64 20 74 64 62 29 0a 3b or-record tdb).; 18d0: 3b 20 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 ; . (sqlite3 18e0: 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 29 :finalize! tdb)) 18f0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 75 69 ))..(define (gui 1900: 2d 6d 6f 6e 69 74 6f 72 20 64 62 29 0a 20 20 28 -monitor db). ( 1910: 6c 65 74 20 28 28 6b 65 79 73 20 28 64 62 3a 67 let ((keys (db:g 1920: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 28 74 et-keys db))..(t 1930: 64 62 20 20 28 74 61 73 6b 73 3a 6f 70 65 6e 2d db (tasks:open- 1940: 64 62 29 29 29 0a 20 20 20 20 28 74 61 73 6b 73 db))). (tasks 1950: 3a 72 65 67 69 73 74 65 72 2d 6d 6f 6e 69 74 6f :register-monito 1960: 72 20 64 62 20 74 64 62 29 20 3b 3b 3b 20 6c 65 r db tdb) ;;; le 1970: 74 20 74 68 65 20 6f 74 68 65 72 20 6d 6f 6e 69 t the other moni 1980: 74 6f 72 73 20 6b 6e 6f 77 20 77 65 20 61 72 65 tors know we are 1990: 20 68 65 72 65 0a 20 20 20 20 28 63 6f 6e 74 72 here. (contr 19a0: 6f 6c 2d 70 61 6e 65 6c 20 64 62 20 74 64 62 20 ol-panel db tdb 19b0: 6b 65 79 73 29 0a 20 20 20 20 3b 28 74 61 73 6b keys). ;(task 19c0: 73 3a 72 65 6d 6f 76 65 2d 6d 6f 6e 69 74 6f 72 s:remove-monitor 19d0: 2d 72 65 63 6f 72 64 20 64 62 29 0a 20 20 20 20 -record db). 19e0: 3b 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 ;(sqlite3:finali 19f0: 7a 65 21 20 64 62 29 0a 20 20 20 29 29 0a 09 0a ze! db). ))...