Megatest

Hex Artifact Content
Login

Artifact cc16a02e3886531cbf6c4fe717beecadb08a30e9:


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 54 68 69 73 20 66 69  ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65  le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20  gatest..;; .;;  
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66     Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f  ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75  u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64  te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e  ify.;;     it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66  der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c   the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20   Public License 
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a  as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20  ;;     the Free 
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74  Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73  ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63  ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20  ense, or.;;     
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29  (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69   any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d  on..;; .;;     M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72  egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f  ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20  pe that it will 
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20  be useful,.;;   
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e    but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68  Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70  out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66  lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54  .;;     MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45  ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55  SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65  LAR PURPOSE.  Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55  e the.;;     GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20   General Public 
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65  License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b   details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20       You should 
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20  have received a 
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20  copy of the GNU 
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c  General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c  icense.;;     al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73  ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20  t.  If not, see 
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e  <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a  org/licenses/>..
0340: 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;;.;;===========
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d  ===========..;;=
0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
03a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
03d0: 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 69 6e  =====.;; Test in
03e0: 66 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d  fo panel.;;=====
03f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0430: 3d 0a 0a 28 69 6d 70 6f 72 74 20 66 6f 72 6d 61  =..(import forma
0440: 74 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66  t).(import (pref
0450: 69 78 20 69 75 70 20 69 75 70 3a 29 29 0a 28 69  ix iup iup:)).(i
0460: 6d 70 6f 72 74 20 63 61 6e 76 61 73 2d 64 72 61  mport canvas-dra
0470: 77 29 0a 0a 28 69 6d 70 6f 72 74 0a 20 73 72 66  w)..(import. srf
0480: 69 2d 31 0a 20 63 68 69 63 6b 65 6e 2e 66 69 6c  i-1. chicken.fil
0490: 65 2e 70 6f 73 69 78 20 72 65 67 65 78 20 72 65  e.posix regex re
04a0: 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d 36 39  gex-case srfi-69
04b0: 0a 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65  . (prefix sqlite
04c0: 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64  3 sqlite3:))..(d
04d0: 65 63 6c 61 72 65 20 28 75 6e 69 74 20 64 61 73  eclare (unit das
04e0: 68 62 6f 61 72 64 2d 67 75 69 6d 6f 6e 69 74 6f  hboard-guimonito
04f0: 72 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73  r)).(declare (us
0500: 65 73 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28  es commonmod)).(
0510: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6b 65  declare (uses ke
0520: 79 73 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 65  ysmod)).(declare
0530: 20 28 75 73 65 73 20 64 62 6d 6f 64 29 29 0a 28   (uses dbmod)).(
0540: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 61  declare (uses ta
0550: 73 6b 73 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72  sksmod)).(declar
0560: 65 20 28 75 73 65 73 20 64 65 62 75 67 70 72 69  e (uses debugpri
0570: 6e 74 29 29 0a 0a 3b 3b 20 28 69 6e 63 6c 75 64  nt))..;; (includ
0580: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64  e "common_record
0590: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65  s.scm").(include
05a0: 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d   "db_records.scm
05b0: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e  ").(include "run
05c0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28  _records.scm").(
05d0: 69 6e 63 6c 75 64 65 20 22 74 61 73 6b 5f 72 65  include "task_re
05e0: 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 28 69 6d  cords.scm")..(im
05f0: 70 6f 72 74 0a 20 63 6f 6d 6d 6f 6e 6d 6f 64 0a  port. commonmod.
0600: 20 6b 65 79 73 6d 6f 64 0a 20 64 62 6d 6f 64 0a   keysmod. dbmod.
0610: 20 74 61 73 6b 73 6d 6f 64 0a 20 64 65 62 75 67   tasksmod. debug
0620: 70 72 69 6e 74 0a 20 29 0a 0a 28 64 65 66 69 6e  print. )..(defin
0630: 65 20 28 63 6f 6e 74 72 6f 6c 2d 70 61 6e 65 6c  e (control-panel
0640: 20 64 62 20 74 64 62 20 6b 65 79 73 29 0a 20 20   db tdb keys).  
0650: 28 6c 65 74 2a 20 28 28 76 61 72 2d 70 61 72 61  (let* ((var-para
0660: 6d 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61  ms (make-hash-ta
0670: 62 6c 65 29 29 20 3b 3b 20 72 65 67 69 73 74 65  ble)) ;; registe
0680: 72 20 61 6c 6c 20 74 68 65 20 77 69 64 67 65 74  r all the widget
0690: 73 20 68 65 72 65 20 66 6f 72 20 71 75 65 72 79  s here for query
06a0: 69 6e 67 20 6f 6e 20 72 75 6e 2c 20 72 6f 6c 6c  ing on run, roll
06b0: 75 70 2c 20 72 65 6d 6f 76 65 3f 0a 09 20 28 6b  up, remove?.. (k
06c0: 65 79 2d 70 61 72 61 6d 73 20 28 6d 61 6b 65 2d  ey-params (make-
06d0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28  hash-table)).. (
06e0: 6d 6f 6e 69 74 6f 72 64 61 74 20 27 28 29 29 20  monitordat '()) 
06f0: 3b 3b 20 6c 69 73 74 20 6f 66 20 6d 6f 6e 69 74  ;; list of monit
0700: 6f 72 20 72 65 63 6f 72 64 73 0a 09 20 28 6b 65  or records.. (ke
0710: 79 65 6e 74 72 69 65 73 20 28 69 75 70 3a 66 72  yentries (iup:fr
0720: 61 6d 65 20 0a 09 09 20 20 20 20 20 20 23 3a 74  ame ...      #:t
0730: 69 74 6c 65 20 22 4b 65 79 73 22 0a 09 09 20 20  itle "Keys"...  
0740: 20 20 20 20 28 61 70 70 6c 79 0a 09 09 20 20 20      (apply...   
0750: 20 20 20 20 69 75 70 3a 76 62 6f 78 0a 09 09 20      iup:vbox... 
0760: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62        (map (lamb
0770: 64 61 20 28 6b 65 79 29 0a 09 09 09 20 20 20 20  da (key)....    
0780: 20 20 28 69 75 70 3a 68 62 6f 78 20 28 69 75 70    (iup:hbox (iup
0790: 3a 6c 61 62 65 6c 20 28 76 65 63 74 6f 72 2d 72  :label (vector-r
07a0: 65 66 20 6b 65 79 20 30 29 20 23 3a 73 69 7a 65  ef key 0) #:size
07b0: 20 22 36 30 78 31 35 22 29 20 3b 20 23 3a 65 78   "60x15") ; #:ex
07c0: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c  pand "HORIZONTAL
07d0: 22 29 0a 09 09 09 09 09 28 69 75 70 3a 74 65 78  ")......(iup:tex
07e0: 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 48  tbox #:expand "H
07f0: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 09  ORIZONTAL"......
0800: 09 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28  .     #:action (
0810: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 61 20 76 61  lambda (obj a va
0820: 6c 29 0a 09 09 09 09 09 09 09 09 28 68 61 73 68  l).........(hash
0830: 2d 74 61 62 6c 65 2d 73 65 74 21 20 6b 65 79 2d  -table-set! key-
0840: 70 61 72 61 6d 73 20 28 76 65 63 74 6f 72 2d 72  params (vector-r
0850: 65 66 20 6b 65 79 20 30 29 20 76 61 6c 29 29 29  ef key 0) val)))
0860: 29 29 0a 09 09 09 20 20 20 20 6b 65 79 73 29 29  ))....    keys))
0870: 29 29 0a 09 20 28 6f 74 68 65 72 76 61 72 73 20  )).. (othervars 
0880: 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 09 20 20   (iup:frame...  
0890: 20 20 20 20 23 3a 74 69 74 6c 65 20 22 52 75 6e      #:title "Run
08a0: 20 56 61 72 73 22 0a 09 09 20 20 20 20 20 20 28   Vars"...      (
08b0: 61 70 70 6c 79 0a 09 09 20 20 20 20 20 20 20 69  apply...       i
08c0: 75 70 3a 76 62 6f 78 0a 09 09 20 20 20 20 20 20  up:vbox...      
08d0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76   (map (lambda (v
08e0: 61 72 29 0a 09 09 09 20 20 20 20 20 20 28 69 75  ar)....      (iu
08f0: 70 3a 68 62 6f 78 20 28 69 75 70 3a 6c 61 62 65  p:hbox (iup:labe
0900: 6c 20 76 61 72 20 23 3a 73 69 7a 65 20 22 36 30  l var #:size "60
0910: 78 31 35 22 29 0a 09 09 09 09 09 28 69 75 70 3a  x15")......(iup:
0920: 74 65 78 74 62 6f 78 20 20 20 23 3a 65 78 70 61  textbox   #:expa
0930: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a  nd "HORIZONTAL".
0940: 09 09 09 09 09 09 20 20 20 20 20 20 20 23 3a 61  ......       #:a
0950: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f  ction (lambda (o
0960: 62 6a 20 61 20 76 61 6c 29 0a 09 09 09 09 09 09  bj a val).......
0970: 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d  ..  (hash-table-
0980: 73 65 74 21 20 76 61 72 2d 70 61 72 61 6d 73 20  set! var-params 
0990: 76 61 72 20 76 61 6c 29 29 29 29 29 0a 09 09 09  var val)))))....
09a0: 20 20 20 20 28 6c 69 73 74 20 22 72 75 6e 6e 61      (list "runna
09b0: 6d 65 22 20 22 74 65 73 74 70 61 74 74 73 22 20  me" "testpatts" 
09c0: 22 70 61 72 61 6d 73 22 29 29 29 29 29 0a 09 20  "params"))))).. 
09d0: 28 63 6f 6e 74 72 6f 6c 73 20 20 20 28 69 75 70  (controls   (iup
09e0: 3a 66 72 61 6d 65 0a 09 09 20 20 20 20 20 20 23  :frame...      #
09f0: 3a 74 69 74 6c 65 20 22 43 6f 6e 74 72 6f 6c 73  :title "Controls
0a00: 22 0a 09 09 20 20 20 20 20 20 28 69 75 70 3a 68  "...      (iup:h
0a10: 62 6f 78 20 0a 09 09 20 20 20 20 20 20 20 28 69  box ...       (i
0a20: 75 70 3a 66 72 61 6d 65 0a 09 09 09 23 3a 74 69  up:frame....#:ti
0a30: 74 6c 65 20 22 52 75 6e 73 22 0a 09 09 09 28 69  tle "Runs"....(i
0a40: 75 70 3a 68 62 6f 78 20 0a 09 09 09 20 28 69 75  up:hbox .... (iu
0a50: 70 3a 62 75 74 74 6f 6e 20 22 53 74 61 72 74 22  p:button "Start"
0a60: 20 20 0a 09 09 09 09 20 20 20 20 20 23 3a 65 78    .....     #:ex
0a70: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c  pand "HORIZONTAL
0a80: 22 0a 09 09 09 09 20 20 20 20 20 23 3a 61 63 74  ".....     #:act
0a90: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a  ion (lambda (obj
0aa0: 29 0a 09 09 09 09 09 09 28 74 61 73 6b 73 3a 61  ).......(tasks:a
0ab0: 64 64 2d 66 72 6f 6d 2d 70 61 72 61 6d 73 20 74  dd-from-params t
0ac0: 64 62 20 22 72 75 6e 22 20 6b 65 79 73 20 6b 65  db "run" keys ke
0ad0: 79 2d 70 61 72 61 6d 73 20 76 61 72 2d 70 61 72  y-params var-par
0ae0: 61 6d 73 29 0a 09 09 09 09 09 09 28 70 72 69 6e  ams).......(prin
0af0: 74 20 22 4c 61 75 6e 63 68 20 52 75 6e 22 29 29  t "Launch Run"))
0b00: 29 0a 09 09 09 20 28 69 75 70 3a 62 75 74 74 6f  ).... (iup:butto
0b10: 6e 20 22 52 65 6d 6f 76 65 22 20 0a 09 09 09 09  n "Remove" .....
0b20: 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48       #:expand "H
0b30: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20  ORIZONTAL"..... 
0b40: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61      #:action (la
0b50: 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 09  mbda (obj)......
0b60: 09 28 70 72 69 6e 74 20 22 52 65 6d 6f 76 65 20  .(print "Remove 
0b70: 52 75 6e 22 29 0a 09 09 09 09 09 09 28 74 61 73  Run").......(tas
0b80: 6b 73 3a 61 64 64 2d 66 72 6f 6d 2d 70 61 72 61  ks:add-from-para
0b90: 6d 73 20 74 64 62 20 22 72 65 6d 6f 76 65 22 20  ms tdb "remove" 
0ba0: 6b 65 79 73 20 6b 65 79 2d 70 61 72 61 6d 73 20  keys key-params 
0bb0: 76 61 72 2d 70 61 72 61 6d 73 29 0a 09 09 09 09  var-params).....
0bc0: 09 09 29 29 0a 09 09 09 20 28 69 75 70 3a 62 75  ..)).... (iup:bu
0bd0: 74 74 6f 6e 20 22 52 6f 6c 6c 75 70 22 20 0a 09  tton "Rollup" ..
0be0: 09 09 09 20 20 20 20 20 23 3a 65 78 70 61 6e 64  ...     #:expand
0bf0: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09   "HORIZONTAL"...
0c00: 09 09 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20  ..     #:action 
0c10: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09  (lambda (obj)...
0c20: 09 09 09 09 28 70 72 69 6e 74 20 22 52 6f 6c 6c  ....(print "Roll
0c30: 75 70 20 52 75 6e 22 29 0a 09 09 09 09 09 09 28  up Run").......(
0c40: 74 61 73 6b 73 3a 61 64 64 2d 66 72 6f 6d 2d 70  tasks:add-from-p
0c50: 61 72 61 6d 73 20 74 64 62 20 22 72 6f 6c 6c 75  arams tdb "rollu
0c60: 70 22 20 6b 65 79 73 20 6b 65 79 2d 70 61 72 61  p" keys key-para
0c70: 6d 73 20 76 61 72 2d 70 61 72 61 6d 73 29 29 29  ms var-params)))
0c80: 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 75 70  ))...       (iup
0c90: 3a 66 72 61 6d 65 20 0a 09 09 09 23 3a 74 69 74  :frame ....#:tit
0ca0: 6c 65 20 22 4d 69 73 63 22 0a 09 09 09 28 69 75  le "Misc"....(iu
0cb0: 70 3a 68 62 6f 78 0a 09 09 09 20 28 69 75 70 3a  p:hbox.... (iup:
0cc0: 62 75 74 74 6f 6e 20 22 51 75 69 74 22 20 0a 09  button "Quit" ..
0cd0: 09 09 09 20 20 20 20 20 23 3a 65 78 70 61 6e 64  ...     #:expand
0ce0: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09   "HORIZONTAL"...
0cf0: 09 09 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20  ..     #:action 
0d00: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09  (lambda (obj)...
0d10: 09 09 09 09 28 73 71 6c 69 74 65 33 3a 66 69 6e  ....(sqlite3:fin
0d20: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 09 09  alize! db)......
0d30: 09 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69  .(sqlite3:finali
0d40: 7a 65 21 20 74 64 62 29 0a 09 09 09 09 09 09 28  ze! tdb).......(
0d50: 65 78 69 74 29 29 29 29 29 29 29 29 0a 09 20 28  exit)))))))).. (
0d60: 6d 6f 6e 69 74 6f 72 73 20 20 20 20 20 28 69 75  monitors     (iu
0d70: 70 3a 74 65 78 74 62 6f 78 20 0a 09 09 09 23 3a  p:textbox ....#:
0d80: 65 78 70 61 6e 64 20 22 59 45 53 22 20 3b 20 48  expand "YES" ; H
0d90: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 3b 20  ORIZONTAL"....; 
0da0: 23 3a 73 69 7a 65 20 20 20 22 78 34 30 22 0a 09  #:size   "x40"..
0db0: 09 09 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 22 59  ..#:multiline "Y
0dc0: 45 53 22 0a 09 09 09 23 3a 66 6f 6e 74 20 22 43  ES"....#:font "C
0dd0: 6f 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22  ourier New, -10"
0de0: 0a 09 09 09 23 3a 76 61 6c 75 65 20 22 4e 6f 6e  ....#:value "Non
0df0: 65 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e  e...............
0e00: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e  ................
0e10: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e  ................
0e20: 22 29 29 0a 09 20 28 61 63 74 69 6f 6e 73 20 20  ")).. (actions  
0e30: 20 20 20 20 28 69 75 70 3a 74 65 78 74 62 6f 78      (iup:textbox
0e40: 0a 09 09 09 23 3a 65 78 70 61 6e 64 20 22 59 45  ....#:expand "YE
0e50: 53 22 0a 09 09 09 23 3a 6d 75 6c 74 69 6c 69 6e  S"....#:multilin
0e60: 65 20 22 59 45 53 22 0a 09 09 09 23 3a 66 6f 6e  e "YES"....#:fon
0e70: 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 2c 20  t "Courier New, 
0e80: 2d 31 30 22 0a 09 09 09 23 3a 76 61 6c 75 65 20  -10"....#:value 
0e90: 22 4e 6f 6e 65 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e  "None...........
0ea0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e  ................
0eb0: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e  ................
0ec0: 2e 2e 2e 2e 22 29 29 0a 09 20 28 6c 61 73 74 6d  ....")).. (lastm
0ed0: 6f 64 74 69 6d 65 20 30 29 0a 09 20 28 6e 65 78  odtime 0).. (nex
0ee0: 74 2d 74 6f 75 63 68 20 20 30 29 20 3b 3b 20 74  t-touch  0) ;; t
0ef0: 68 65 20 6c 61 73 74 20 74 69 6d 65 20 74 68 65  he last time the
0f00: 20 22 6c 61 73 74 5f 75 70 64 61 74 65 22 20 66   "last_update" f
0f10: 69 65 6c 64 20 77 61 73 20 75 70 64 61 74 65 64  ield was updated
0f20: 0a 09 20 28 72 65 66 72 65 73 68 64 61 74 20 28  .. (refreshdat (
0f30: 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20  lambda ()...    
0f40: 20 20 20 28 6c 65 74 2a 20 28 28 6d 6f 6e 69 74     (let* ((monit
0f50: 6f 72 64 62 70 61 74 68 20 20 28 63 6f 6e 63 20  ordbpath  (conc 
0f60: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 6f 6e 69  *toppath* "/moni
0f70: 74 6f 72 2e 64 62 22 29 29 0a 09 09 09 20 20 20  tor.db"))....   
0f80: 20 20 20 28 6d 65 67 61 74 65 73 74 64 62 70 61     (megatestdbpa
0f90: 74 68 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74  th (conc *toppat
0fa0: 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 62  h* "/megatest.db
0fb0: 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 6d 6f  "))....      (mo
0fc0: 64 74 69 6d 65 20 20 20 20 20 20 20 20 28 6d 61  dtime        (ma
0fd0: 78 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61  x (file-modifica
0fe0: 74 69 6f 6e 2d 74 69 6d 65 20 6d 65 67 61 74 65  tion-time megate
0ff0: 73 74 64 62 70 61 74 68 29 0a 09 09 09 09 09 09  stdbpath).......
1000: 20 20 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63     (file-modific
1010: 61 74 69 6f 6e 2d 74 69 6d 65 20 6d 6f 6e 69 74  ation-time monit
1020: 6f 72 64 62 70 61 74 68 29 29 29 29 0a 09 09 09  ordbpath))))....
1030: 20 3b 3b 20 64 6f 20 73 74 75 66 66 20 68 65 72   ;; do stuff her
1040: 65 20 77 68 65 6e 20 74 68 65 20 64 62 20 69 73  e when the db is
1050: 20 75 70 64 61 74 65 64 20 62 79 20 73 6f 6d 65   updated by some
1060: 20 6f 74 68 65 72 20 70 72 6f 63 65 73 73 0a 09   other process..
1070: 09 09 20 28 69 66 20 28 3e 20 6d 6f 64 74 69 6d  .. (if (> modtim
1080: 65 20 6c 61 73 74 6d 6f 64 74 69 6d 65 29 0a 09  e lastmodtime)..
1090: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 74 6c  ..     (let ((tl
10a0: 73 74 20 28 74 61 73 6b 73 3a 67 65 74 2d 74 61  st (tasks:get-ta
10b0: 73 6b 73 20 74 64 62 20 27 28 29 20 27 28 29 29  sks tdb '() '())
10c0: 29 0a 09 09 09 09 20 20 20 28 6d 6c 73 74 20 28  ).....   (mlst (
10d0: 74 61 73 6b 73 3a 67 65 74 2d 6d 6f 6e 69 74 6f  tasks:get-monito
10e0: 72 73 20 74 64 62 29 29 29 0a 09 09 09 20 20 20  rs tdb)))....   
10f0: 20 20 20 20 28 73 65 74 21 20 74 61 73 6b 73 64      (set! tasksd
1100: 61 74 20 74 6c 73 74 29 0a 09 09 09 20 20 20 20  at tlst)....    
1110: 20 20 20 28 73 65 74 21 20 6d 6f 6e 69 74 6f 72     (set! monitor
1120: 73 64 61 74 20 6d 6c 73 74 29 0a 09 09 09 20 20  sdat mlst)....  
1130: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62       (iup:attrib
1140: 75 74 65 2d 73 65 74 21 20 6d 6f 6e 69 74 6f 72  ute-set! monitor
1150: 73 20 22 56 41 4c 55 45 22 20 28 74 61 73 6b 73  s "VALUE" (tasks
1160: 3a 6d 6f 6e 69 74 6f 72 73 2d 3e 74 65 78 74 2d  :monitors->text-
1170: 74 61 62 6c 65 20 6d 6c 73 74 29 29 0a 09 09 09  table mlst))....
1180: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72         (iup:attr
1190: 69 62 75 74 65 2d 73 65 74 21 20 61 63 74 69 6f  ibute-set! actio
11a0: 6e 73 20 20 22 56 41 4c 55 45 22 20 28 74 61 73  ns  "VALUE" (tas
11b0: 6b 73 3a 74 61 73 6b 73 2d 3e 74 65 78 74 20 74  ks:tasks->text t
11c0: 6c 73 74 29 29 0a 09 09 09 20 20 20 20 20 20 20  lst))....       
11d0: 28 74 61 73 6b 73 3a 70 72 6f 63 65 73 73 2d 71  (tasks:process-q
11e0: 75 65 75 65 20 64 62 20 74 64 62 29 0a 09 09 09  ueue db tdb)....
11f0: 20 20 20 20 20 20 20 28 73 65 74 21 20 6c 61 73         (set! las
1200: 74 6d 6f 64 74 69 6d 65 20 28 6d 61 78 20 28 66  tmodtime (max (f
1210: 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e  ile-modification
1220: 2d 74 69 6d 65 20 6d 65 67 61 74 65 73 74 64 62  -time megatestdb
1230: 70 61 74 68 29 0a 09 09 09 09 09 09 20 20 20 20  path).......    
1240: 20 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61    (file-modifica
1250: 74 69 6f 6e 2d 74 69 6d 65 20 6d 6f 6e 69 74 6f  tion-time monito
1260: 72 64 62 70 61 74 68 29 29 29 0a 09 09 09 20 20  rdbpath)))....  
1270: 20 20 20 20 20 28 74 61 73 6b 73 3a 72 65 73 65       (tasks:rese
1280: 74 2d 73 74 75 63 6b 2d 74 61 73 6b 73 20 74 64  t-stuck-tasks td
1290: 62 29 29 29 0a 09 09 09 20 3b 3b 20 73 74 75 66  b))).... ;; stuf
12a0: 66 20 74 6f 20 64 6f 20 65 76 65 72 79 20 31 30  f to do every 10
12b0: 20 73 65 63 6f 6e 64 73 0a 09 09 09 20 28 69 66   seconds.... (if
12c0: 20 28 3e 20 28 63 75 72 72 65 6e 74 2d 73 65 63   (> (current-sec
12d0: 6f 6e 64 73 29 20 6e 65 78 74 2d 74 6f 75 63 68  onds) next-touch
12e0: 29 0a 09 09 09 20 20 20 20 20 28 62 65 67 69 6e  )....     (begin
12f0: 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 28 74  ....       ;; (t
1300: 61 73 6b 73 3a 70 72 6f 63 65 73 73 2d 71 75 65  asks:process-que
1310: 75 65 20 64 62 20 74 64 62 20 6d 6f 6e 69 74 6f  ue db tdb monito
1320: 72 64 62 70 61 74 68 29 0a 09 09 09 20 20 20 20  rdbpath)....    
1330: 20 20 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f     (tasks:monito
1340: 72 73 2d 75 70 64 61 74 65 20 74 64 62 29 0a 09  rs-update tdb)..
1350: 09 09 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a  ..       (tasks:
1360: 72 65 73 65 74 2d 73 74 75 63 6b 2d 74 61 73 6b  reset-stuck-task
1370: 73 20 74 64 62 29 0a 09 09 09 20 20 20 20 20 20  s tdb)....      
1380: 20 28 73 65 74 21 20 6d 6f 6e 69 74 6f 72 73 64   (set! monitorsd
1390: 61 74 20 28 74 61 73 6b 73 3a 67 65 74 2d 6d 6f  at (tasks:get-mo
13a0: 6e 69 74 6f 72 73 20 74 64 62 29 29 0a 09 09 09  nitors tdb))....
13b0: 20 20 20 20 20 20 20 28 73 65 74 21 20 6e 65 78         (set! nex
13c0: 74 2d 74 6f 75 63 68 20 28 2b 20 28 63 75 72 72  t-touch (+ (curr
13d0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 31 30 29  ent-seconds) 10)
13e0: 29 0a 09 09 09 20 20 20 20 20 20 20 29 29 29 29  )....       ))))
13f0: 29 0a 09 20 28 74 6f 70 64 69 61 6c 6f 67 20 20  ).. (topdialog  
1400: 23 66 29 29 0a 20 20 20 20 28 73 65 74 21 20 74  #f)).    (set! t
1410: 6f 70 64 69 61 6c 6f 67 20 28 69 75 70 3a 64 69  opdialog (iup:di
1420: 61 6c 6f 67 20 0a 09 09 20 20 20 20 20 23 3a 63  alog ...     #:c
1430: 6c 6f 73 65 5f 63 62 20 28 6c 61 6d 62 64 61 20  lose_cb (lambda 
1440: 28 61 29 28 65 78 69 74 29 29 0a 09 09 20 20 20  (a)(exit))...   
1450: 20 20 23 3a 74 69 74 6c 65 20 22 52 75 6e 20 43    #:title "Run C
1460: 6f 6e 74 72 6f 6c 73 22 0a 09 09 20 20 20 20 20  ontrols"...     
1470: 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 20 20 20  (iup:vbox...    
1480: 20 20 28 69 75 70 3a 68 62 6f 78 20 6b 65 79 65    (iup:hbox keye
1490: 6e 74 72 69 65 73 20 6f 74 68 65 72 76 61 72 73  ntries othervars
14a0: 29 0a 09 09 20 20 20 20 20 20 63 6f 6e 74 72 6f  )...      contro
14b0: 6c 73 0a 09 09 20 20 20 20 20 20 28 6c 65 74 20  ls...      (let 
14c0: 28 28 74 61 62 74 6f 70 20 28 69 75 70 3a 74 61  ((tabtop (iup:ta
14d0: 62 73 20 0a 09 09 09 09 20 20 20 20 20 28 69 75  bs .....     (iu
14e0: 70 3a 76 62 6f 78 20 0a 09 09 09 09 20 20 20 20  p:vbox .....    
14f0: 20 20 20 28 6c 65 74 2a 20 28 28 74 62 20 28 69     (let* ((tb (i
1500: 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 65 78 70  up:textbox #:exp
1510: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22  and "HORIZONTAL"
1520: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 62  ))......      (b
1530: 74 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52  t (iup:button "R
1540: 65 6d 6f 76 65 20 74 61 73 6b 73 20 62 79 20 69  emove tasks by i
1550: 64 22 0a 09 09 09 09 09 09 09 20 20 20 20 20 20  d"........      
1560: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61  #:action (lambda
1570: 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 09 09 09   (obj)..........
1580: 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 75 70   (let ((val (iup
1590: 3a 61 74 74 72 69 62 75 74 65 20 74 62 20 22 56  :attribute tb "V
15a0: 41 4c 55 45 22 29 29 29 0a 09 09 09 09 09 09 09  ALUE")))........
15b0: 09 09 20 20 20 28 74 61 73 6b 73 3a 72 65 6d 6f  ..   (tasks:remo
15c0: 76 65 2d 71 75 65 75 65 2d 65 6e 74 72 69 65 73  ve-queue-entries
15d0: 20 74 64 62 20 76 61 6c 29 29 29 29 29 0a 09 09   tdb val)))))...
15e0: 09 09 09 20 20 20 20 20 20 28 6c 62 20 28 69 75  ...      (lb (iu
15f0: 70 3a 6c 61 62 65 6c 20 22 28 63 6f 6d 6d 61 20  p:label "(comma 
1600: 73 65 70 61 72 61 74 65 64 29 22 29 29 29 0a 09  separated)")))..
1610: 09 09 09 09 20 28 69 75 70 3a 68 62 6f 78 20 62  .... (iup:hbox b
1620: 74 20 74 62 20 6c 62 29 29 0a 09 09 09 09 20 20  t tb lb)).....  
1630: 20 20 20 20 20 61 63 74 69 6f 6e 73 29 0a 09 09       actions)...
1640: 09 09 20 20 20 20 20 6d 6f 6e 69 74 6f 72 73 0a  ..     monitors.
1650: 09 09 09 09 20 20 20 20 20 29 29 29 0a 09 09 09  ....     )))....
1660: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73  (iup:attribute-s
1670: 65 74 21 20 74 61 62 74 6f 70 20 22 54 41 42 54  et! tabtop "TABT
1680: 49 54 4c 45 30 22 20 22 41 63 74 69 6f 6e 73 22  ITLE0" "Actions"
1690: 29 0a 09 09 09 28 69 75 70 3a 61 74 74 72 69 62  )....(iup:attrib
16a0: 75 74 65 2d 73 65 74 21 20 74 61 62 74 6f 70 20  ute-set! tabtop 
16b0: 22 54 41 42 54 49 54 4c 45 31 22 20 22 4d 6f 6e  "TABTITLE1" "Mon
16c0: 69 74 6f 72 73 22 29 0a 09 09 09 74 61 62 74 6f  itors")....tabto
16d0: 70 29 0a 09 09 20 20 20 20 20 20 29 29 29 0a 09  p)...      )))..
16e0: 09 20 20 20 20 20 20 3b 20 28 69 75 70 3a 66 72  .      ; (iup:fr
16f0: 61 6d 65 0a 09 09 20 20 20 20 20 20 3b 20 20 23  ame...      ;  #
1700: 3a 74 69 74 6c 65 20 22 4d 6f 6e 69 74 6f 72 73  :title "Monitors
1710: 22 0a 09 09 20 20 20 20 20 20 3b 20 20 6d 6f 6e  "...      ;  mon
1720: 69 74 6f 72 73 29 0a 09 09 20 20 20 20 20 20 3b  itors)...      ;
1730: 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 09 20 20   (iup:frame...  
1740: 20 20 20 20 3b 20 20 23 3a 74 69 74 6c 65 20 22      ;  #:title "
1750: 41 63 74 69 6f 6e 73 22 0a 09 09 20 20 20 20 20  Actions"...     
1760: 20 3b 20 20 61 63 74 69 6f 6e 73 29 29 29 29 0a   ;  actions)))).
1770: 0a 20 20 20 20 28 69 75 70 3a 73 68 6f 77 20 74  .    (iup:show t
1780: 6f 70 64 69 61 6c 6f 67 29 0a 20 20 20 20 28 69  opdialog).    (i
1790: 75 70 3a 63 61 6c 6c 62 61 63 6b 2d 73 65 74 21  up:callback-set!
17a0: 20 2a 74 69 6d 2a 20 22 41 43 54 49 4f 4e 5f 43   *tim* "ACTION_C
17b0: 42 22 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d  B"...       (lam
17c0: 62 64 61 20 28 78 29 0a 09 09 09 20 28 72 65 66  bda (x).... (ref
17d0: 72 65 73 68 64 61 74 29 0a 09 09 09 20 28 69 66  reshdat).... (if
17e0: 20 2a 65 78 69 74 2d 73 74 61 72 74 65 64 2a 0a   *exit-started*.
17f0: 09 09 09 20 20 20 20 20 28 73 65 74 21 20 2a 65  ...     (set! *e
1800: 78 69 74 2d 73 74 61 72 74 65 64 2a 20 27 6f 6b  xit-started* 'ok
1810: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20  ))))))..(define 
1820: 28 6d 61 69 6e 2d 77 69 6e 64 6f 77 20 73 65 74  (main-window set
1830: 75 70 74 61 62 20 66 73 6c 74 61 62 20 63 6f 6c  uptab fsltab col
1840: 6c 61 74 65 72 61 6c 74 61 62 20 74 6f 6f 6c 73  lateraltab tools
1850: 74 61 62 29 0a 20 20 28 69 75 70 3a 73 68 6f 77  tab).  (iup:show
1860: 0a 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 20  .   (iup:dialog 
1870: 23 3a 74 69 74 6c 65 20 22 46 53 4c 20 50 6f 77  #:title "FSL Pow
1880: 65 72 20 57 69 6e 64 6f 77 22 20 23 3a 73 69 7a  er Window" #:siz
1890: 65 20 22 32 39 30 78 31 39 30 22 20 3b 20 23 3a  e "290x190" ; #:
18a0: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20  expand "YES".   
18b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74              (let
18c0: 20 28 28 74 61 62 74 6f 70 20 28 69 75 70 3a 74   ((tabtop (iup:t
18d0: 61 62 73 20 73 65 74 75 70 74 61 62 20 63 6f 6c  abs setuptab col
18e0: 6c 61 74 65 72 61 6c 74 61 62 20 66 73 6c 74 61  lateraltab fslta
18f0: 62 20 74 6f 6f 6c 73 74 61 62 29 29 29 0a 20 20  b toolstab))).  
1900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
1910: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65  iup:attribute-se
1920: 74 21 20 74 61 62 74 6f 70 20 22 54 41 42 54 49  t! tabtop "TABTI
1930: 54 4c 45 30 22 20 22 53 65 74 75 70 22 29 20 0a  TLE0" "Setup") .
1940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1950: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d   (iup:attribute-
1960: 73 65 74 21 20 74 61 62 74 6f 70 20 22 54 41 42  set! tabtop "TAB
1970: 54 49 54 4c 45 31 22 20 22 43 6f 6c 6c 61 74 65  TITLE1" "Collate
1980: 72 61 6c 22 29 0a 20 20 20 20 20 20 20 20 20 20  ral").          
1990: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72         (iup:attr
19a0: 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 74 6f  ibute-set! tabto
19b0: 70 20 22 54 41 42 54 49 54 4c 45 32 22 20 22 46  p "TABTITLE2" "F
19c0: 6f 73 73 69 6c 22 29 0a 20 20 20 20 20 20 20 20  ossil").        
19d0: 20 20 20 20 20 20 20 20 20 28 69 75 70 3a 61 74           (iup:at
19e0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 61 62  tribute-set! tab
19f0: 74 6f 70 20 22 54 41 42 54 49 54 4c 45 33 22 20  top "TABTITLE3" 
1a00: 22 54 6f 6f 6c 73 22 29 0a 20 20 20 20 20 20 20  "Tools").       
1a10: 20 20 20 20 20 20 20 20 20 20 74 61 62 74 6f 70            tabtop
1a20: 29 29 29 29 0a 0a 3b 3b 20 42 55 47 3a 20 52 65  ))))..;; BUG: Re
1a30: 6d 65 6d 62 65 72 20 74 6f 20 72 65 2d 69 6e 73  member to re-ins
1a40: 74 61 74 65 20 74 68 69 73 21 21 21 21 0a 3b 3b  tate this!!!!.;;
1a50: 20 28 6f 6e 2d 65 78 69 74 20 28 6c 61 6d 62 64   (on-exit (lambd
1a60: 61 20 28 29 0a 3b 3b 20 09 20 20 20 28 6c 65 74  a ().;; .   (let
1a70: 20 28 28 74 64 62 20 28 74 61 73 6b 73 3a 6f 70   ((tdb (tasks:op
1a80: 65 6e 2d 64 62 29 29 29 0a 3b 3b 20 09 20 20 20  en-db))).;; .   
1a90: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 4f 6e 2d    ;; (print "On-
1aa0: 65 78 69 74 20 63 61 6c 6c 65 64 22 29 0a 3b 3b  exit called").;;
1ab0: 20 09 20 20 20 20 20 28 74 61 73 6b 73 3a 72 65   .     (tasks:re
1ac0: 6d 6f 76 65 2d 6d 6f 6e 69 74 6f 72 2d 72 65 63  move-monitor-rec
1ad0: 6f 72 64 20 74 64 62 29 0a 3b 3b 20 09 20 20 20  ord tdb).;; .   
1ae0: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c    (sqlite3:final
1af0: 69 7a 65 21 20 74 64 62 29 29 29 29 0a 0a 28 64  ize! tdb))))..(d
1b00: 65 66 69 6e 65 20 28 67 75 69 2d 6d 6f 6e 69 74  efine (gui-monit
1b10: 6f 72 20 64 62 29 0a 20 20 28 6c 65 74 20 28 28  or db).  (let ((
1b20: 6b 65 79 73 20 28 64 62 3a 67 65 74 2d 6b 65 79  keys (db:get-key
1b30: 73 20 64 62 29 29 0a 09 28 74 64 62 20 20 28 74  s db))..(tdb  (t
1b40: 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 29 0a  asks:open-db))).
1b50: 20 20 20 20 28 74 61 73 6b 73 3a 72 65 67 69 73      (tasks:regis
1b60: 74 65 72 2d 6d 6f 6e 69 74 6f 72 20 64 62 20 74  ter-monitor db t
1b70: 64 62 29 20 3b 3b 3b 20 6c 65 74 20 74 68 65 20  db) ;;; let the 
1b80: 6f 74 68 65 72 20 6d 6f 6e 69 74 6f 72 73 20 6b  other monitors k
1b90: 6e 6f 77 20 77 65 20 61 72 65 20 68 65 72 65 0a  now we are here.
1ba0: 20 20 20 20 28 63 6f 6e 74 72 6f 6c 2d 70 61 6e      (control-pan
1bb0: 65 6c 20 64 62 20 74 64 62 20 6b 65 79 73 29 0a  el db tdb keys).
1bc0: 20 20 20 20 3b 28 74 61 73 6b 73 3a 72 65 6d 6f      ;(tasks:remo
1bd0: 76 65 2d 6d 6f 6e 69 74 6f 72 2d 72 65 63 6f 72  ve-monitor-recor
1be0: 64 20 64 62 29 0a 20 20 20 20 3b 28 73 71 6c 69  d db).    ;(sqli
1bf0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62  te3:finalize! db
1c00: 29 0a 20 20 20 29 29 0a 09 0a                    ).   ))...