Artifact 44f34bd92a11051aef52226989435c8dbb13c039:
- File dashboard-guimonitor.scm — part of check-in [0a116daff3] at 2012-04-01 23:29:41 on branch trunk — Updated copyrights (user: mrwellan size: 6614)
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 69 74 65 6d 70 61 74 74 73 atts" "itempatts 07c0: 22 20 22 70 61 72 61 6d 73 22 29 29 29 29 29 0a " "params"))))). 07d0: 09 20 28 63 6f 6e 74 72 6f 6c 73 20 20 20 28 69 . (controls (i 07e0: 75 70 3a 66 72 61 6d 65 0a 09 09 20 20 20 20 20 up:frame... 07f0: 20 23 3a 74 69 74 6c 65 20 22 43 6f 6e 74 72 6f #:title "Contro 0800: 6c 73 22 0a 09 09 20 20 20 20 20 20 28 69 75 70 ls"... (iup 0810: 3a 68 62 6f 78 20 0a 09 09 20 20 20 20 20 20 20 :hbox ... 0820: 28 69 75 70 3a 66 72 61 6d 65 0a 09 09 09 23 3a (iup:frame....#: 0830: 74 69 74 6c 65 20 22 52 75 6e 73 22 0a 09 09 09 title "Runs".... 0840: 28 69 75 70 3a 68 62 6f 78 20 0a 09 09 09 20 28 (iup:hbox .... ( 0850: 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 74 61 72 iup:button "Star 0860: 74 22 20 20 0a 09 09 09 09 20 20 20 20 20 23 3a t" ..... #: 0870: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 0880: 41 4c 22 0a 09 09 09 09 20 20 20 20 20 23 3a 61 AL"..... #:a 0890: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o 08a0: 62 6a 29 0a 09 09 09 09 09 09 28 74 61 73 6b 73 bj).......(tasks 08b0: 3a 61 64 64 2d 66 72 6f 6d 2d 70 61 72 61 6d 73 :add-from-params 08c0: 20 74 64 62 20 22 72 75 6e 22 20 6b 65 79 73 20 tdb "run" keys 08d0: 6b 65 79 2d 70 61 72 61 6d 73 20 76 61 72 2d 70 key-params var-p 08e0: 61 72 61 6d 73 29 0a 09 09 09 09 09 09 28 70 72 arams).......(pr 08f0: 69 6e 74 20 22 4c 61 75 6e 63 68 20 52 75 6e 22 int "Launch Run" 0900: 29 29 29 0a 09 09 09 20 28 69 75 70 3a 62 75 74 ))).... (iup:but 0910: 74 6f 6e 20 22 52 65 6d 6f 76 65 22 20 0a 09 09 ton "Remove" ... 0920: 09 09 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 .. #:expand 0930: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL".... 0940: 09 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 . #:action ( 0950: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj).... 0960: 09 09 09 28 70 72 69 6e 74 20 22 52 65 6d 6f 76 ...(print "Remov 0970: 65 20 52 75 6e 22 29 0a 09 09 09 09 09 09 28 74 e Run").......(t 0980: 61 73 6b 73 3a 61 64 64 2d 66 72 6f 6d 2d 70 61 asks:add-from-pa 0990: 72 61 6d 73 20 74 64 62 20 22 72 65 6d 6f 76 65 rams tdb "remove 09a0: 22 20 6b 65 79 73 20 6b 65 79 2d 70 61 72 61 6d " keys key-param 09b0: 73 20 76 61 72 2d 70 61 72 61 6d 73 29 0a 09 09 s var-params)... 09c0: 09 09 09 09 29 29 0a 09 09 09 20 28 69 75 70 3a ....)).... (iup: 09d0: 62 75 74 74 6f 6e 20 22 52 6f 6c 6c 75 70 22 20 button "Rollup" 09e0: 0a 09 09 09 09 20 20 20 20 20 23 3a 65 78 70 61 ..... #:expa 09f0: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL". 0a00: 09 09 09 09 20 20 20 20 20 23 3a 61 63 74 69 6f .... #:actio 0a10: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a n (lambda (obj). 0a20: 09 09 09 09 09 09 28 70 72 69 6e 74 20 22 52 6f ......(print "Ro 0a30: 6c 6c 75 70 20 52 75 6e 22 29 0a 09 09 09 09 09 llup Run")...... 0a40: 09 28 74 61 73 6b 73 3a 61 64 64 2d 66 72 6f 6d .(tasks:add-from 0a50: 2d 70 61 72 61 6d 73 20 74 64 62 20 22 72 6f 6c -params tdb "rol 0a60: 6c 75 70 22 20 6b 65 79 73 20 6b 65 79 2d 70 61 lup" keys key-pa 0a70: 72 61 6d 73 20 76 61 72 2d 70 61 72 61 6d 73 29 rams var-params) 0a80: 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 ))))... (i 0a90: 75 70 3a 66 72 61 6d 65 20 0a 09 09 09 23 3a 74 up:frame ....#:t 0aa0: 69 74 6c 65 20 22 4d 69 73 63 22 0a 09 09 09 28 itle "Misc"....( 0ab0: 69 75 70 3a 68 62 6f 78 0a 09 09 09 20 28 69 75 iup:hbox.... (iu 0ac0: 70 3a 62 75 74 74 6f 6e 20 22 51 75 69 74 22 20 p:button "Quit" 0ad0: 0a 09 09 09 09 20 20 20 20 20 23 3a 65 78 70 61 ..... #:expa 0ae0: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL". 0af0: 09 09 09 09 20 20 20 20 20 23 3a 61 63 74 69 6f .... #:actio 0b00: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a n (lambda (obj). 0b10: 09 09 09 09 09 09 28 73 71 6c 69 74 65 33 3a 66 ......(sqlite3:f 0b20: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 inalize! db).... 0b30: 09 09 09 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 ...(sqlite3:fina 0b40: 6c 69 7a 65 21 20 74 64 62 29 0a 09 09 09 09 09 lize! tdb)...... 0b50: 09 28 65 78 69 74 29 29 29 29 29 29 29 29 0a 09 .(exit)))))))).. 0b60: 20 28 6d 6f 6e 69 74 6f 72 73 20 20 20 20 20 28 (monitors ( 0b70: 69 75 70 3a 74 65 78 74 62 6f 78 20 0a 09 09 09 iup:textbox .... 0b80: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 20 3b #:expand "YES" ; 0b90: 20 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 HORIZONTAL".... 0ba0: 3b 20 23 3a 73 69 7a 65 20 20 20 22 78 34 30 22 ; #:size "x40" 0bb0: 0a 09 09 09 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 ....#:multiline 0bc0: 22 59 45 53 22 0a 09 09 09 23 3a 66 6f 6e 74 20 "YES"....#:font 0bd0: 22 43 6f 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 "Courier New, -1 0be0: 30 22 0a 09 09 09 23 3a 76 61 6c 75 65 20 22 4e 0"....#:value "N 0bf0: 6f 6e 65 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e one............. 0c00: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 0c10: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 0c20: 2e 2e 22 29 29 0a 09 20 28 61 63 74 69 6f 6e 73 ..")).. (actions 0c30: 20 20 20 20 20 20 28 69 75 70 3a 74 65 78 74 62 (iup:textb 0c40: 6f 78 0a 09 09 09 23 3a 65 78 70 61 6e 64 20 22 ox....#:expand " 0c50: 59 45 53 22 0a 09 09 09 23 3a 6d 75 6c 74 69 6c YES"....#:multil 0c60: 69 6e 65 20 22 59 45 53 22 0a 09 09 09 23 3a 66 ine "YES"....#:f 0c70: 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 ont "Courier New 0c80: 2c 20 2d 31 30 22 0a 09 09 09 23 3a 76 61 6c 75 , -10"....#:valu 0c90: 65 20 22 4e 6f 6e 65 2e 2e 2e 2e 2e 2e 2e 2e 2e e "None......... 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 2e 2e 2e 2e 2e 2e ................ 0cc0: 2e 2e 2e 2e 2e 2e 22 29 29 0a 09 20 28 6c 61 73 ......")).. (las 0cd0: 74 6d 6f 64 74 69 6d 65 20 30 29 0a 09 20 28 6e tmodtime 0).. (n 0ce0: 65 78 74 2d 74 6f 75 63 68 20 20 30 29 20 3b 3b ext-touch 0) ;; 0cf0: 20 74 68 65 20 6c 61 73 74 20 74 69 6d 65 20 74 the last time t 0d00: 68 65 20 22 6c 61 73 74 5f 75 70 64 61 74 65 22 he "last_update" 0d10: 20 66 69 65 6c 64 20 77 61 73 20 75 70 64 61 74 field was updat 0d20: 65 64 0a 09 20 28 72 65 66 72 65 73 68 64 61 74 ed.. (refreshdat 0d30: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 (lambda ()... 0d40: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6d 6f 6e (let* ((mon 0d50: 69 74 6f 72 64 62 70 61 74 68 20 20 28 63 6f 6e itordbpath (con 0d60: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 6f c *toppath* "/mo 0d70: 6e 69 74 6f 72 2e 64 62 22 29 29 0a 09 09 09 20 nitor.db")).... 0d80: 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 64 62 (megatestdb 0d90: 70 61 74 68 20 28 63 6f 6e 63 20 2a 74 6f 70 70 path (conc *topp 0da0: 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e ath* "/megatest. 0db0: 64 62 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 db")).... ( 0dc0: 6d 6f 64 74 69 6d 65 20 20 20 20 20 20 20 20 28 modtime ( 0dd0: 6d 61 78 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 max (file-modifi 0de0: 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6d 65 67 61 cation-time mega 0df0: 74 65 73 74 64 62 70 61 74 68 29 0a 09 09 09 09 testdbpath)..... 0e00: 09 09 20 20 20 28 66 69 6c 65 2d 6d 6f 64 69 66 .. (file-modif 0e10: 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6d 6f 6e ication-time mon 0e20: 69 74 6f 72 64 62 70 61 74 68 29 29 29 29 0a 09 itordbpath)))).. 0e30: 09 09 20 3b 3b 20 64 6f 20 73 74 75 66 66 20 68 .. ;; do stuff h 0e40: 65 72 65 20 77 68 65 6e 20 74 68 65 20 64 62 20 ere when the db 0e50: 69 73 20 75 70 64 61 74 65 64 20 62 79 20 73 6f is updated by so 0e60: 6d 65 20 6f 74 68 65 72 20 70 72 6f 63 65 73 73 me other process 0e70: 0a 09 09 09 20 28 69 66 20 28 3e 20 6d 6f 64 74 .... (if (> modt 0e80: 69 6d 65 20 6c 61 73 74 6d 6f 64 74 69 6d 65 29 ime lastmodtime) 0e90: 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 .... (let (( 0ea0: 74 6c 73 74 20 28 74 61 73 6b 73 3a 67 65 74 2d tlst (tasks:get- 0eb0: 74 61 73 6b 73 20 74 64 62 20 27 28 29 20 27 28 tasks tdb '() '( 0ec0: 29 29 29 0a 09 09 09 09 20 20 20 28 6d 6c 73 74 )))..... (mlst 0ed0: 20 28 74 61 73 6b 73 3a 67 65 74 2d 6d 6f 6e 69 (tasks:get-moni 0ee0: 74 6f 72 73 20 74 64 62 29 29 29 0a 09 09 09 20 tors tdb))).... 0ef0: 20 20 20 20 20 20 28 73 65 74 21 20 74 61 73 6b (set! task 0f00: 73 64 61 74 20 74 6c 73 74 29 0a 09 09 09 20 20 sdat tlst).... 0f10: 20 20 20 20 20 28 73 65 74 21 20 6d 6f 6e 69 74 (set! monit 0f20: 6f 72 73 64 61 74 20 6d 6c 73 74 29 0a 09 09 09 orsdat mlst).... 0f30: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr 0f40: 69 62 75 74 65 2d 73 65 74 21 20 6d 6f 6e 69 74 ibute-set! monit 0f50: 6f 72 73 20 22 56 41 4c 55 45 22 20 28 74 61 73 ors "VALUE" (tas 0f60: 6b 73 3a 6d 6f 6e 69 74 6f 72 73 2d 3e 74 65 78 ks:monitors->tex 0f70: 74 2d 74 61 62 6c 65 20 6d 6c 73 74 29 29 0a 09 t-table mlst)).. 0f80: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 .. (iup:at 0f90: 74 72 69 62 75 74 65 2d 73 65 74 21 20 61 63 74 tribute-set! act 0fa0: 69 6f 6e 73 20 20 22 56 41 4c 55 45 22 20 28 74 ions "VALUE" (t 0fb0: 61 73 6b 73 3a 74 61 73 6b 73 2d 3e 74 65 78 74 asks:tasks->text 0fc0: 20 74 6c 73 74 29 29 0a 09 09 09 20 20 20 20 20 tlst)).... 0fd0: 20 20 28 74 61 73 6b 73 3a 70 72 6f 63 65 73 73 (tasks:process 0fe0: 2d 71 75 65 75 65 20 64 62 20 74 64 62 29 0a 09 -queue db tdb).. 0ff0: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6c .. (set! l 1000: 61 73 74 6d 6f 64 74 69 6d 65 20 28 6d 61 78 20 astmodtime (max 1010: 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 (file-modificati 1020: 6f 6e 2d 74 69 6d 65 20 6d 65 67 61 74 65 73 74 on-time megatest 1030: 64 62 70 61 74 68 29 0a 09 09 09 09 09 09 20 20 dbpath)....... 1040: 20 20 20 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 (file-modifi 1050: 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6d 6f 6e 69 cation-time moni 1060: 74 6f 72 64 62 70 61 74 68 29 29 29 0a 09 09 09 tordbpath))).... 1070: 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a 72 65 (tasks:re 1080: 73 65 74 2d 73 74 75 63 6b 2d 74 61 73 6b 73 20 set-stuck-tasks 1090: 74 64 62 29 29 29 0a 09 09 09 20 3b 3b 20 73 74 tdb))).... ;; st 10a0: 75 66 66 20 74 6f 20 64 6f 20 65 76 65 72 79 20 uff to do every 10b0: 31 30 20 73 65 63 6f 6e 64 73 0a 09 09 09 20 28 10 seconds.... ( 10c0: 69 66 20 28 3e 20 28 63 75 72 72 65 6e 74 2d 73 if (> (current-s 10d0: 65 63 6f 6e 64 73 29 20 6e 65 78 74 2d 74 6f 75 econds) next-tou 10e0: 63 68 29 0a 09 09 09 20 20 20 20 20 28 62 65 67 ch).... (beg 10f0: 69 6e 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 in.... ;; 1100: 28 74 61 73 6b 73 3a 70 72 6f 63 65 73 73 2d 71 (tasks:process-q 1110: 75 65 75 65 20 64 62 20 74 64 62 20 6d 6f 6e 69 ueue db tdb moni 1120: 74 6f 72 64 62 70 61 74 68 29 0a 09 09 09 20 20 tordbpath).... 1130: 20 20 20 20 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 (tasks:moni 1140: 74 6f 72 73 2d 75 70 64 61 74 65 20 74 64 62 29 tors-update tdb) 1150: 0a 09 09 09 20 20 20 20 20 20 20 28 74 61 73 6b .... (task 1160: 73 3a 72 65 73 65 74 2d 73 74 75 63 6b 2d 74 61 s:reset-stuck-ta 1170: 73 6b 73 20 74 64 62 29 0a 09 09 09 20 20 20 20 sks tdb).... 1180: 20 20 20 28 73 65 74 21 20 6d 6f 6e 69 74 6f 72 (set! monitor 1190: 73 64 61 74 20 28 74 61 73 6b 73 3a 67 65 74 2d sdat (tasks:get- 11a0: 6d 6f 6e 69 74 6f 72 73 20 74 64 62 29 29 0a 09 monitors tdb)).. 11b0: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6e .. (set! n 11c0: 65 78 74 2d 74 6f 75 63 68 20 28 2b 20 28 63 75 ext-touch (+ (cu 11d0: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 31 rrent-seconds) 1 11e0: 30 29 29 0a 09 09 09 20 20 20 20 20 20 20 29 29 0)).... )) 11f0: 29 29 29 0a 09 20 28 74 6f 70 64 69 61 6c 6f 67 ))).. (topdialog 1200: 20 20 23 66 29 29 0a 20 20 20 20 28 73 65 74 21 #f)). (set! 1210: 20 74 6f 70 64 69 61 6c 6f 67 20 28 69 75 70 3a topdialog (iup: 1220: 64 69 61 6c 6f 67 20 0a 09 09 20 20 20 20 20 23 dialog ... # 1230: 3a 63 6c 6f 73 65 5f 63 62 20 28 6c 61 6d 62 64 :close_cb (lambd 1240: 61 20 28 61 29 28 65 78 69 74 29 29 0a 09 09 20 a (a)(exit))... 1250: 20 20 20 20 23 3a 74 69 74 6c 65 20 22 52 75 6e #:title "Run 1260: 20 43 6f 6e 74 72 6f 6c 73 22 0a 09 09 20 20 20 Controls"... 1270: 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 20 (iup:vbox... 1280: 20 20 20 20 28 69 75 70 3a 68 62 6f 78 20 6b 65 (iup:hbox ke 1290: 79 65 6e 74 72 69 65 73 20 6f 74 68 65 72 76 61 yentries otherva 12a0: 72 73 29 0a 09 09 20 20 20 20 20 20 63 6f 6e 74 rs)... cont 12b0: 72 6f 6c 73 0a 09 09 20 20 20 20 20 20 28 6c 65 rols... (le 12c0: 74 20 28 28 74 61 62 74 6f 70 20 28 69 75 70 3a t ((tabtop (iup: 12d0: 74 61 62 73 20 0a 09 09 09 09 20 20 20 20 20 28 tabs ..... ( 12e0: 69 75 70 3a 76 62 6f 78 20 0a 09 09 09 09 20 20 iup:vbox ..... 12f0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 62 20 (let* ((tb 1300: 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 65 (iup:textbox #:e 1310: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA 1320: 4c 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 L"))...... 1330: 28 62 74 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 (bt (iup:button 1340: 22 52 65 6d 6f 76 65 20 74 61 73 6b 73 20 62 79 "Remove tasks by 1350: 20 69 64 22 0a 09 09 09 09 09 09 09 20 20 20 20 id"........ 1360: 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 #:action (lamb 1370: 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 09 da (obj)........ 1380: 09 09 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 .. (let ((val (i 1390: 75 70 3a 61 74 74 72 69 62 75 74 65 20 74 62 20 up:attribute tb 13a0: 22 56 41 4c 55 45 22 29 29 29 0a 09 09 09 09 09 "VALUE")))...... 13b0: 09 09 09 09 20 20 20 28 74 61 73 6b 73 3a 72 65 .... (tasks:re 13c0: 6d 6f 76 65 2d 71 75 65 75 65 2d 65 6e 74 72 69 move-queue-entri 13d0: 65 73 20 74 64 62 20 76 61 6c 29 29 29 29 29 0a es tdb val))))). 13e0: 09 09 09 09 09 20 20 20 20 20 20 28 6c 62 20 28 ..... (lb ( 13f0: 69 75 70 3a 6c 61 62 65 6c 20 22 28 63 6f 6d 6d iup:label "(comm 1400: 61 20 73 65 70 61 72 61 74 65 64 29 22 29 29 29 a separated)"))) 1410: 0a 09 09 09 09 09 20 28 69 75 70 3a 68 62 6f 78 ...... (iup:hbox 1420: 20 62 74 20 74 62 20 6c 62 29 29 0a 09 09 09 09 bt tb lb))..... 1430: 20 20 20 20 20 20 20 61 63 74 69 6f 6e 73 29 0a actions). 1440: 09 09 09 09 20 20 20 20 20 6d 6f 6e 69 74 6f 72 .... monitor 1450: 73 0a 09 09 09 09 20 20 20 20 20 29 29 29 0a 09 s..... ))).. 1460: 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ..(iup:attribute 1470: 2d 73 65 74 21 20 74 61 62 74 6f 70 20 22 54 41 -set! tabtop "TA 1480: 42 54 49 54 4c 45 30 22 20 22 41 63 74 69 6f 6e BTITLE0" "Action 1490: 73 22 29 0a 09 09 09 28 69 75 70 3a 61 74 74 72 s")....(iup:attr 14a0: 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 74 6f ibute-set! tabto 14b0: 70 20 22 54 41 42 54 49 54 4c 45 31 22 20 22 4d p "TABTITLE1" "M 14c0: 6f 6e 69 74 6f 72 73 22 29 0a 09 09 09 74 61 62 onitors")....tab 14d0: 74 6f 70 29 0a 09 09 20 20 20 20 20 20 29 29 29 top)... ))) 14e0: 0a 09 09 20 20 20 20 20 20 3b 20 28 69 75 70 3a ... ; (iup: 14f0: 66 72 61 6d 65 0a 09 09 20 20 20 20 20 20 3b 20 frame... ; 1500: 20 23 3a 74 69 74 6c 65 20 22 4d 6f 6e 69 74 6f #:title "Monito 1510: 72 73 22 0a 09 09 20 20 20 20 20 20 3b 20 20 6d rs"... ; m 1520: 6f 6e 69 74 6f 72 73 29 0a 09 09 20 20 20 20 20 onitors)... 1530: 20 3b 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 09 ; (iup:frame... 1540: 20 20 20 20 20 20 3b 20 20 23 3a 74 69 74 6c 65 ; #:title 1550: 20 22 41 63 74 69 6f 6e 73 22 0a 09 09 20 20 20 "Actions"... 1560: 20 20 20 3b 20 20 61 63 74 69 6f 6e 73 29 29 29 ; actions))) 1570: 29 0a 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 ).. (iup:show 1580: 20 74 6f 70 64 69 61 6c 6f 67 29 0a 20 20 20 20 topdialog). 1590: 28 69 75 70 3a 63 61 6c 6c 62 61 63 6b 2d 73 65 (iup:callback-se 15a0: 74 21 20 2a 74 69 6d 2a 20 22 41 43 54 49 4f 4e t! *tim* "ACTION 15b0: 5f 43 42 22 0a 09 09 20 20 20 20 20 20 20 28 6c _CB"... (l 15c0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 28 72 ambda (x).... (r 15d0: 65 66 72 65 73 68 64 61 74 29 0a 09 09 09 20 28 efreshdat).... ( 15e0: 69 66 20 2a 65 78 69 74 2d 73 74 61 72 74 65 64 if *exit-started 15f0: 2a 0a 09 09 09 20 20 20 20 20 28 73 65 74 21 20 *.... (set! 1600: 2a 65 78 69 74 2d 73 74 61 72 74 65 64 2a 20 27 *exit-started* ' 1610: 6f 6b 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e ok))))))..(defin 1620: 65 20 28 6d 61 69 6e 2d 77 69 6e 64 6f 77 20 73 e (main-window s 1630: 65 74 75 70 74 61 62 20 66 73 6c 74 61 62 20 63 etuptab fsltab c 1640: 6f 6c 6c 61 74 65 72 61 6c 74 61 62 20 74 6f 6f ollateraltab too 1650: 6c 73 74 61 62 29 0a 20 20 28 69 75 70 3a 73 68 lstab). (iup:sh 1660: 6f 77 0a 20 20 20 28 69 75 70 3a 64 69 61 6c 6f ow. (iup:dialo 1670: 67 20 23 3a 74 69 74 6c 65 20 22 46 53 4c 20 50 g #:title "FSL P 1680: 6f 77 65 72 20 57 69 6e 64 6f 77 22 20 23 3a 73 ower Window" #:s 1690: 69 7a 65 20 22 32 39 30 78 31 39 30 22 20 3b 20 ize "290x190" ; 16a0: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 #:expand "YES". 16b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l 16c0: 65 74 20 28 28 74 61 62 74 6f 70 20 28 69 75 70 et ((tabtop (iup 16d0: 3a 74 61 62 73 20 73 65 74 75 70 74 61 62 20 63 :tabs setuptab c 16e0: 6f 6c 6c 61 74 65 72 61 6c 74 61 62 20 66 73 6c ollateraltab fsl 16f0: 74 61 62 20 74 6f 6f 6c 73 74 61 62 29 29 29 0a tab toolstab))). 1700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1710: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute- 1720: 73 65 74 21 20 74 61 62 74 6f 70 20 22 54 41 42 set! tabtop "TAB 1730: 54 49 54 4c 45 30 22 20 22 53 65 74 75 70 22 29 TITLE0" "Setup") 1740: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 1750: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut 1760: 65 2d 73 65 74 21 20 74 61 62 74 6f 70 20 22 54 e-set! tabtop "T 1770: 41 42 54 49 54 4c 45 31 22 20 22 43 6f 6c 6c 61 ABTITLE1" "Colla 1780: 74 65 72 61 6c 22 29 0a 20 20 20 20 20 20 20 20 teral"). 1790: 20 20 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 (iup:at 17a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 tribute-set! tab 17b0: 74 6f 70 20 22 54 41 42 54 49 54 4c 45 32 22 20 top "TABTITLE2" 17c0: 22 46 6f 73 73 69 6c 22 29 0a 20 20 20 20 20 20 "Fossil"). 17d0: 20 20 20 20 20 20 20 20 20 20 20 28 69 75 70 3a (iup: 17e0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 attribute-set! t 17f0: 61 62 74 6f 70 20 22 54 41 42 54 49 54 4c 45 33 abtop "TABTITLE3 1800: 22 20 22 54 6f 6f 6c 73 22 29 0a 20 20 20 20 20 " "Tools"). 1810: 20 20 20 20 20 20 20 20 20 20 20 20 74 61 62 74 tabt 1820: 6f 70 29 29 29 29 0a 0a 28 6f 6e 2d 65 78 69 74 op))))..(on-exit 1830: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 (lambda ().. 1840: 28 6c 65 74 20 28 28 74 64 62 20 28 74 61 73 6b (let ((tdb (task 1850: 73 3a 6f 70 65 6e 2d 64 62 29 29 29 0a 09 20 20 s:open-db))).. 1860: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 4f 6e ;; (print "On 1870: 2d 65 78 69 74 20 63 61 6c 6c 65 64 22 29 0a 09 -exit called").. 1880: 20 20 20 20 20 28 74 61 73 6b 73 3a 72 65 6d 6f (tasks:remo 1890: 76 65 2d 6d 6f 6e 69 74 6f 72 2d 72 65 63 6f 72 ve-monitor-recor 18a0: 64 20 74 64 62 29 0a 09 20 20 20 20 20 28 73 71 d tdb).. (sq 18b0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize! 18c0: 74 64 62 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 tdb))))..(define 18d0: 20 28 67 75 69 2d 6d 6f 6e 69 74 6f 72 20 64 62 (gui-monitor db 18e0: 29 0a 20 20 28 6c 65 74 20 28 28 6b 65 79 73 20 ). (let ((keys 18f0: 28 72 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 (rdb:get-keys db 1900: 29 29 0a 09 28 74 64 62 20 20 28 74 61 73 6b 73 ))..(tdb (tasks 1910: 3a 6f 70 65 6e 2d 64 62 29 29 29 0a 20 20 20 20 :open-db))). 1920: 28 74 61 73 6b 73 3a 72 65 67 69 73 74 65 72 2d (tasks:register- 1930: 6d 6f 6e 69 74 6f 72 20 64 62 20 74 64 62 29 20 monitor db tdb) 1940: 3b 3b 3b 20 6c 65 74 20 74 68 65 20 6f 74 68 65 ;;; let the othe 1950: 72 20 6d 6f 6e 69 74 6f 72 73 20 6b 6e 6f 77 20 r monitors know 1960: 77 65 20 61 72 65 20 68 65 72 65 0a 20 20 20 20 we are here. 1970: 28 63 6f 6e 74 72 6f 6c 2d 70 61 6e 65 6c 20 64 (control-panel d 1980: 62 20 74 64 62 20 6b 65 79 73 29 0a 20 20 20 20 b tdb keys). 1990: 3b 28 74 61 73 6b 73 3a 72 65 6d 6f 76 65 2d 6d ;(tasks:remove-m 19a0: 6f 6e 69 74 6f 72 2d 72 65 63 6f 72 64 20 64 62 onitor-record db 19b0: 29 0a 20 20 20 20 3b 28 73 71 6c 69 74 65 33 3a ). ;(sqlite3: 19c0: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 finalize! db). 19d0: 20 29 29 0a 09 0a ))...