Random Bits of Open Code

Check-in [1247f0c47a]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added mostly working del of users subjects
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:1247f0c47a9f45f59a83988a8f427df1e4df2ef0
User & Date: matt 2018-08-06 06:32:52
Context
2018-08-06
18:23
set area's last updated to curr time - 1 check-in: 663fdaecef user: pjhatwal tags: trunk
06:32
Added mostly working del of users subjects check-in: 1247f0c47a user: matt tags: trunk
2018-08-05
21:07
Removed junk file. Added clean target check-in: fd81fdec44 user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to mtutils/mtconfigf/mtconfigf.scm.

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
         )

(import scheme chicken data-structures extras ports files)
(use posix typed-records srfi-18)
(use regex regex-case srfi-69 srfi-1 directory-utils extras srfi-13 )
(import posix)

;; very wierd, the reference to pathname-directory here fixes a reference to possibly unbound identifier problem
;;
;; (define (dummy-function path)
;;   (pathname-directory path)
;;   (absolute-pathname? path)
;;   (normalize-pathname path))

;;======================================================================
;;
;; CONVERGE THIS WITH mtcommon.scm debug-print stuff
;;
;;======================================================================
(define *verbosity* 4)








<
<
<
<
<
<
<







68
69
70
71
72
73
74







75
76
77
78
79
80
81
         )

(import scheme chicken data-structures extras ports files)
(use posix typed-records srfi-18)
(use regex regex-case srfi-69 srfi-1 directory-utils extras srfi-13 )
(import posix)








;;======================================================================
;;
;; CONVERGE THIS WITH mtcommon.scm debug-print stuff
;;
;;======================================================================
(define *verbosity* 4)

Changes to multiapp/apps/learn-teach/learn-teach-config.scm.

6
7
8
9
10
11
12

13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38


39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55









56
57
58
59
60
61
62
63
64









65

66
67
68
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(declare (unit learn-teach-config))


(module learn-teach-config
    *
  
(import scheme chicken data-structures extras posix srfi-69)

(use (prefix iup iup:)
     srfi-18
     (prefix mtconfigf configf:)
     (prefix mtcommon  common:))


;; we 
(define (read-learn-teach-config #!key (infile #f))
  (let* ((fname (or infile (if (common:windows?) ;; (get-environment-variable "HOME")
			       "learn-teach.config" ;; we must be on windows
			       (conc (get-environment-variable "HOME") "/.learn-teach/config")
			       ))))
    (if (file-exists? fname)
	(begin
	  (print "Loading config file " fname)
	  (configf:read-config fname #f #t))
	(make-hash-table))))

(define (read-areas-config #!key (infile #f))
  (let* ((fname (or infile (if (common:windows?) ;; (get-environment-variable "HOME")
			       "areas.config" ;; we must be on windows


			       (conc (get-environment-variable "HOME") "/.learn-teach/areas.config")
			       ))))
    (if (file-exists? fname)
	(begin
	  (print "Loading config file " fname)
	  (configf:read-config fname #f #t))
	(make-hash-table))))

;; need also write-config which does read-modify-write but it needs to be fixed
;; for now do a for-each write
;;
(define (write-learn-teach-config cfgdat #!key (infile #f))
  (let* ((learn-teachdir (conc (get-environment-variable "HOME") "/.learn-teach"))
	 (fname (or infile (conc learn-teachdir "/config"))))
    (if (not (directory-exists? learn-teachdir))(create-directory learn-teachdir #t))
    (configf:write-config cfgdat fname)))











(define (make-config-tab)
  (let* ((cmatrix (iup:matrix
		   #:alignment "ALEFT"
		   #:expand "YES"
		   #:resizematrix "YES"
		   #:scrollbar "YES"
		   #:numcol 2
		   #:numlin 20)))









    cmatrix))

  
;; end of module
)







>




|




|
>




|
<
<
<
<
<
<
<

<
<
<
>
>
|











|




>
>
>
>
>
>
>
>
>
|
|





|

>
>
>
>
>
>
>
>
>
|
>



6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29







30



31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(declare (unit learn-teach-config))
(declare (uses gui))

(module learn-teach-config
    *
  
(import scheme chicken data-structures extras posix srfi-69 gui)

(use (prefix iup iup:)
     srfi-18
     (prefix mtconfigf configf:)
     (prefix mtcommon  common:)
     )

;; we 
(define (read-learn-teach-config #!key (infile #f))
  (let* ((fname (or infile (if (common:windows?) ;; (get-environment-variable "HOME")
			       "learn-teach/config" ;; we must be on windows











			       ;; inject here a lookup in multiapp config where to find apps by id/id type
			       
			       (conc (get-environment-variable "HOME") "/.multiapp/learn-teach/config")
			       ))))
    (if (file-exists? fname)
	(begin
	  (print "Loading config file " fname)
	  (configf:read-config fname #f #t))
	(make-hash-table))))

;; need also write-config which does read-modify-write but it needs to be fixed
;; for now do a for-each write
;;
(define (write-learn-teach-config cfgdat #!key (infile #f))
  (let* ((learn-teachdir (conc (get-environment-variable "HOME") "/.multiapp/learn-teach"))
	 (fname (or infile (conc learn-teachdir "/config"))))
    (if (not (directory-exists? learn-teachdir))(create-directory learn-teachdir #t))
    (configf:write-config cfgdat fname)))

;; specify all known settings here. This can be used to generate a template settings file
;; and to fill in the form with useful info
;;
(define (known-settings)
  (let ((df (iup:attribute #f "DEFAULTFONT")))
    `( (settings (default-font ,df font "Set the default font for the app")
		 (pkts-dir     #f  path "Packets data stored here")
		 (remote-pkts  #f  path "Sync packets from/to here"))
       )))
  
(define (make-config-tab cfgdat)
  (let* ((cmatrix (iup:matrix
		   #:alignment "ALEFT"
		   #:expand "YES"
		   #:resizematrix "YES"
		   #:scrollbar "YES"
		   #:numcol 4
		   #:numlin 20)))
    (fill-config-matrix cmatrix (known-settings) cfgdat)
    (iup:vbox
     (iup:button
      "Save config"
      expand: "HORIZONTAL"
      action: (lambda (obj)
		(update-cfgdat-from-matrix cfgdat cmatrix)
		(write-learn-teach-config cfgdat)
		))
     cmatrix
     )))
  
;; end of module
)

Changes to multiapp/apps/learn-teach/learn-teach.scm.

46
47
48
49
50
51
52

53
54
55
56
57
58
59
...
104
105
106
107
108
109
110
111




112
113
114
115
116
117
118
...
166
167
168
169
170
171
172




























173
174
175
176
177
178
179
...
190
191
192
193
194
195
196








197
198
199
200
201
202
203
...
247
248
249
250
251
252
253


























254
255
256
257
258
259
260
...
360
361
362
363
364
365
366


















367
368
369
370
371
372
373
...
482
483
484
485
486
487
488


489
490
491
492
493
494
495
...
500
501
502
503
504
505
506





507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
...
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
...
566
567
568
569
570
571
572


573
574
575
576

577
578
579
580
581
582
583
...
617
618
619
620
621
622
623






624
625
626
627
628
629
630
...
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
...
695
696
697
698
699
700
701
702
703
704
705

706
707

708
709
710
711
712
713
714
...
722
723
724
725
726
727
728
729
730
731
732
733
734
735


736
737
738
739
740
741
742
...
777
778
779
780
781
782
783






784
785
786
787
788
789
790
791



























792
793
794
795
796
797
798

799
800
801
802
803
804
805
806
807
808

809

810
811
812
813
814
815
816
...
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
...
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
     (prefix iuputils  iuputils:)
     (prefix mtdb      mtdb:)
     (prefix iuputils  iuputils:)
     srfi-18 srfi-1
     iuputils
     call-with-environment-variables
     (prefix pkts pkts:)

     )

;; (use trace) ;; see trace at end of file

(defstruct learn-teach ;; rename this! it is confusing due to collision with module name!
  filters
  row-order
................................................................................
		 (tslot    . l)))    ;; reference to the time slot
    (vote     . ((app      . a)	     
		 (person   . p)      ;; whos vote is this
		 ;; (session  . s)      ;; to be implemented, for now store the Z of both subject and tslot
		 (tZ       . t)
		 (sZ       . s)
		 (vote     . v)      ;; 0 or 1 to vote against/for i.e. vote 0 to cancel previous vote of 1
		 )))) ;; reference to the session pkt being voted for





(define learn-teach-pkts-dir (conc (current-directory) "/pkts"))

(if (not (directory-exists? learn-teach-pkts-dir))(create-directory learn-teach-pkts-dir #t))
	     
(define signal-reset-exception 
   (make-exception "Reset request recived." 'reset-request-exn))
................................................................................
		       learn-teach-pkts-dir
		       (lambda (pdb)
			 (pkts:find-pkts pdb '(subject) `((p . ,user-name)
							  ;; (a . "tnl")
							  )))))) ;; filter on subject and app. TODO, fix to use apkts and eliminate query based on key letters
    my-pkts))





























(define (read-time-slots)
  (pkts:with-queue-db
   learn-teach-pkts-dir
   (lambda (pdb)
     (pkts:find-pkts pdb '(tslot) `((a . "tnl")) pkt-spec: pkt-spec)))) ;; filter on tutor and app. TODO, fix to use apkts and eliminate query based on key letters

;; filter out past slots (or override with get-old to actually get the old slots)
................................................................................

(define (read-subjects)
  (pkts:with-queue-db
   learn-teach-pkts-dir
   (lambda (pdb)
     (pkts:find-pkts pdb '(subject) `((a . "tnl")))))) ;; filter on subject and app. TODO, fix to use apkts and eliminate query based on key letters









;; tZ and sZ are the Z values of the two pkts
;;
(define (get-votes sZ tZ)
  ;; (print "sZ: " sZ " tZ: " tZ)
  (pkts:with-queue-db
   learn-teach-pkts-dir
   (lambda (pdb)
................................................................................
;;
(define (calc-total-votes avotes)
  (apply + (map (lambda (x)(or x 0))(hash-table-values avotes))))

;; (use trace)
;; (trace-call-sites #t)
;; (trace pkts:dpkt->alist)



























;;======================================================================
;; Time and Date
;;======================================================================

(define std-time-def "%Y/%m/%d %H:%M %Z")

................................................................................
		  (get-and-fill-my-subjects my-subjects-tree my-subjects my-id data)
		  (for-each (lambda (x)
			      (iup:attribute-set! x "BGCOLOR" "255 255 255"))
			    (list level-edit-box subject-edit-box category-edit-box)))
		(iup:attribute-set! level-edit-box "BGCOLOR" "255 200 255"))
	    (iup:attribute-set! subject-edit-box "BGCOLOR" "255 200 255"))
	(iup:attribute-set! category-edit-box "BGCOLOR" "255 200 255"))))



















(define (get-add-ht ht-in key)
  (let ((ht (hash-table-ref/default ht-in key #f)))
    (if ht
	ht
	(let ((ht (make-hash-table)))
	  (hash-table-set! ht-in key ht)
................................................................................
	      '(1 2 3 4 5 6 7 8 9 10 11))
    sessions-matrix))

;; Learn view panel
(defstruct vf
  (sZ         #f)
  (tZ         #f)


  
  (data       #f)
  (datetime   (iup:label size: "120x" expand: "HORIZONTAL"))
  (day        (iup:label size: "120x" expand: "HORIZONTAL"))
  (category   (iup:label size: "120x" expand: "HORIZONTAL"))
  (subject    (iup:label size: "120x" expand: "HORIZONTAL"))
  (level      (iup:label size: "120x" expand: "HORIZONTAL"))
................................................................................
  (myvote     (iup:label size: "120x" expand: "HORIZONTAL"))
  (votebutton #f);; (iup:button "Yes"))
  (form       #f))

(define (heading-label val)
  (iup:label val size: "50x"))






(define (setup-vote-form vf)
  (let ((btn (iup:button "Yes"
			 action: (lambda (obj)
				   (let* ((curr-val  (iup:attribute obj "TITLE"))
					  (new-vote  (if (equal? curr-val "Yes") 1 0)) ;; if Yes we are voting a 1, else vote a 0
					  (new-title (if (eq? new-vote 1) "Yes" "No"))
					  (new-btn-t (if (eq? new-vote 1) "No"  "Yes"))
					  (path      (cons "Subjects"
							   (map (lambda (x)
								  (iup:attribute x "TITLE"))
								(list (vf-category vf)(vf-subject vf)(vf-level vf)(vf-datetime vf)))))
					  ;; (path2     (append (take path 3)(list (conc (last path) " y"))))
					  )
				     (print "new-vote: " new-vote " curr-val: " curr-val " new-title: " new-title " new-btn-t: " new-btn-t)
				     (iup:attribute-set! obj "TITLE" new-title)
				     (iup:attribute-set! (vf-myvote vf) "TITLE" new-btn-t) ;; set button to *opposite* of the vote
				     (iup:attribute-set! (vf-votes vf)  "TITLE" (conc ((if (eq? new-vote 1) + -)
										       (string->number (iup:attribute (vf-votes vf) "TITLE"))
										       1)))
				     (set-vote (vf-data vf) new-vote (get-my-id)(vf-sZ vf)(vf-tZ vf) path))))))
    (vf-votebutton-set! vf btn)
    (vf-form-set!
     vf
     (iup:frame
      title: "Vote to attend a tutorial, change your vote with the button below."
      (iup:vbox
       (iup:gridbox
................................................................................
	(heading-label "Confirmed?")  (vf-state       vf)     (heading-label "Tot Votes:") (vf-votes    vf)
	(heading-label "My vote:")    (vf-myvote      vf))
       (iup:hbox (heading-label "Details:")   (or (vf-details  vf) ""))
       (iup:hbox
	(iup:label "Set your vote ") btn)))))
   vf)

(define-inline (set-label! lbl value)
  (iup:attribute-set! lbl "TITLE" (conc value))
  (iup:attribute-set! lbl "REDRAW" "ALL")) ;; convert numbers, symbols etc. to strings

(define (populate-vote-form vf data spkt tpkt) ;; sZ tZ datetime category subject level details instructor state data)
  (let* (;; spkt
	 (stype       (alist-ref 'pkt-type    spkt))  ;; subject
	 (sZ          (alist-ref 'Z           spkt))
	 (instructor  (alist-ref 'person      spkt))
	 (category    (alist-ref 'category    spkt))
	 (subject     (alist-ref 'name        spkt))
................................................................................
	 (weekday      (if date-timeval (time->day date-timeval) "-"))
	 (dispkey     (conc sZ "-" tZ))
	 (votes  (get-and-agregate-votes sZ tZ))
	 (tot    (calc-total-votes votes))
	 (my-id  (get-my-id))
	 (myvote (hash-table-ref/default votes my-id 0))
	 (btntitle (if (eq? myvote 0) "Yes" "No")))


    (vf-sZ-set! vf sZ)
    (vf-tZ-set! vf tZ)
    (vf-data-set! vf data)
    (set-label! (vf-datetime   vf) datestr)

    (set-label! (vf-category   vf) category)
    (set-label! (vf-subject    vf) subject)
    (set-label! (vf-level      vf) level)
    (set-label! (vf-details    vf) details)
    (set-label! (vf-instructor vf) instructor)
    (set-label! (vf-state      vf) "-")
    (set-label! (vf-votes      vf) tot)
................................................................................
;;======================================================================
;; Main
;;======================================================================

(define (make-tab)
  (letrec* ((data               (make-hash-table)) ;; more flexible than a record, over time migrate items from this to defstructs
	    (bundle-filter-tb   (iup:textbox value: "%"  expand: "HORIZONTAL" action: (lambda (obj a b)(reset-request 'reset))))






	    ;;====================LEARN====================
	    (vote-form      (setup-vote-form (make-vf)))
	    (vote-btn       (vf-votebutton vote-form))
	    (subjects-tree  (iup:treebox
			     #:value 0
			     #:title "Subjects" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."
			     #:expand "YES"
................................................................................
				       ;; redirect to the form
				       (populate-vote-form vote-form data spkt tpkt) ;; sZ tZ datestr category subject level details tutor "-" data)
				       )
				 path))))
	    (sessions-matrix  (let* ((headings '("Id" "TZ" "Year/Month/Day" "Week Day" "Time" "  Subject  " "Level" "Instructor" "Confirmed" "Votes" "My vote" "           Details           " ))
				     (sm (iup:matrix
					  #:alignment1 "ALEFT"
					  #:expand "YES" ;; "HORIZONTAL"
					  #:resizematrix "YES"
					  #:scrollbar "YES"
					  #:numcol (- (length headings) 1) ;; zeroth column (row header) is not counted.
					  #:numlin 200
					  ;; #:numcol-visible 8 ;; (min 8)
					  #:numlin-visible 8
					  #:click-cb
					  (lambda (mobj row col status)
					    (cond
					     ((eq? col 0) #f) ;; do stuff for column 0 click
					     ((and (> col 0)(> row 0)) ;;any column
					      (letrec* ((combos    (get-add-ht data 'displayed-combos))
							(info      (reverse-lookup-hash-table combos row))
................................................................................
				       expand: "HORIZONTAL")
			    (iup:split
			     #:orientation "VERTICAL"
			     #:value 100
			     (iup:frame
			      title: "Browse All Subjects and Times"
			      subjects-tree)
			     (iup:frame
			      title: "Vote for a subject/time combinatiion"
			      (iup:vbox
			       (iup:label "Click on an entry to change your vote. Add new entries by selecting from the tree to the left, then vote.")

			       sessions-matrix
			       (vf-form vote-form)))

			     )))
	    ;;====================TEACH====================
	    (my-subjects-tree  (iup:treebox
				#:value 0
				;; #:name "Subjects"
				#:title "Subjects" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."
				#:expand "YES"
................................................................................
				    (if (> plen 1)(iup:attribute-set! category-edit-box "VALUE" (cadr path))) ;; have at least the category
				    (if (> plen 2)(iup:attribute-set! subject-edit-box  "VALUE" (caddr path))) ;; have at least the category
				    (if (> plen 3)(iup:attribute-set! level-edit-box    "VALUE" (cadddr path))) ;; have at least the category
				    path))))
	    (time-slots   (get-and-fill-time-slots
			   (gui:fill-matrix-headings
			    (iup:matrix
			     #:expand "YES"
			     #:alignment "ALEFT"
			     #:resizematrix "YES"
			     #:scrollbar "YES"
			     #:numcol 3
			     #:numlin 200
			     #:numlin-visible 8)


			    '("Id" "Date" "Time" "Week Day")
			    fit-text: #t)
			   (current-user-name)))
	    (update-day     (lambda (obj cnum val)(print "Got day=" val)))
	    (update-time    (lambda (obj cnum val)
			      (iup:attribute-set! time-edit-box "BGCOLOR"
						  (if (valid-time val)
................................................................................
			       (iup:label "Day:"   Size: "30x16" )   day-edit-box (iup:label "(mon,tue,wed,thu,fri,sat,sun)" expand: "HORIZONTAL")
			       (iup:label "TZone:" Size: "30x16" ) tzone-edit-box (iup:label "(Three letter timezone code)"  expand: "HORIZONTAL"))
			      ;; (iup:label "")
			      (iup:hbox
			       (iup:button "Add"     action: add-time-slot    expand: "HORIZONTAL") ;; "YES")
			       (iup:button "Delete"  action: delete-time-slot expand: "HORIZONTAL")) ;; "YES"))
			      )))






	    (my-subjects   (gui:fill-matrix-headings
			    (iup:matrix
			     #:alignment "ALEFT"
			     #:expand "YES"
			     #:resizematrix "YES"
			     #:scrollbar "YES"
			     #:numcol 4
			     #:numlin 20)



























			    '("Id" "Category" "Subject" "Level" "Details" "")
			    fit-text: #t))
	    (category-edit-box (iup:textbox expand: "HORIZONTAL"))
	    (subject-edit-box  (iup:textbox expand: "HORIZONTAL"))
	    (level-edit-box    (iup:textbox expand: "HORIZONTAL"))
	    (details-edit-box  (iup:textbox expand: "HORIZONTAL" multiline: "YES" size: "50x10"))
	    (add-category-subject (lambda (obj)(save-category-subject my-subjects-tree my-subjects category-edit-box subject-edit-box level-edit-box details-edit-box data)))

	    (add/edit-subject (iup:frame
			       title: "Add/Edit Subject"
			       (iup:vbox
				(iup:gridbox
				 numdiv: 2
				 expand: "YES"
				 (iup:label "Category:" size: "40x16") category-edit-box
				 (iup:label "Subject:"  size: "40x16") subject-edit-box
				 (iup:label "Level:"    size: "40x16") level-edit-box
				 (iup:label "Details:"  size: "40x16") details-edit-box )

				(iup:button "Add" action: add-category-subject expand: "HORIZONTAL"))))

	    (teach         (iup:hbox
			    (iup:split
			     #:orientation "VERTICAL"
			     ;; #:value 00  ;; aprox 50%
			     (iup:frame
			      ;; (iup:label  "Enter the Subjects You Teach" expand: "HORIZONTAL" fontsize: "13" alignment: "ACENTER")
			      title:  "      Add Subjects You Teach" fontsize: "13"
................................................................................
			      ;; (iup:label  "Specify Your Time Slots" expand: "HORIZONTAL" fontsize: "13" alignment: "ACENTER")
			      title: "      Specify Your Time Slots" fontsize: "13"
			      (iup:vbox
			       time-slots
			       add/edit-slot)))
			    ))
	    (help          (help-drawing))
	    (config        (make-config-tab))
	    (gui           (let ((side-tabs (iup:tabs
					     #:tabtype "LEFT"
					     (car help)
					     learn
					     teach
					     config
					     )))
			     (iup:attribute-set! side-tabs "TABTITLE0" "Help")
			     (iup:attribute-set! side-tabs "TABTITLE1" "Learn")
			     (iup:attribute-set! side-tabs "TABTITLE2" "Teach")
			     (iup:attribute-set! side-tabs "TABTITLE3" "Config")
			     side-tabs))
	    (cfgdat       (read-learn-teach-config))
	    (mydata       #f) ;; hash table with pointers to all the stuff we need to keep track of, could use a struct but not sure I can safely test it for being compatible
	    (learn-teach-dat (make-learn-teach ;; we store the state private to this tab in here
			      ;; top-controls:  top-controls
			      subjects-tree:   subjects-tree
			      sessions-matrix:  sessions-matrix
			      bundle-filter: bundle-filter-tb
			      config:        cfgdat
................................................................................
				    (hash-table-set! alldats mytabnum newdat)
				    (set! mydata newdat)
				    (hash-table-set! newdat 'areas (make-hash-table))))
				 ((not mydata) ;; have mydat but it is not available in mydata
				  ;; (print "INFO: save tab dat")
				  (set! mydata mydat)) ;; this will not ever get hit until there is a finder of shared dat
				 ;; refresh any needed area data if it has been more than 1 second since the last update
				 ((or (> tdelta 3) ;; minumum of every four seconds update the matrix
				      (hash-table-ref/default data 'need-redraw #f))
				  ;; (print "Got here")
				  ;; (print "INFO: update matrix curr " currsec " last " last-up " tdelta " tdelta)
				  ;; (update-matrix learn-teach-dat tdelta)
				  (load-pkts)
				  (get-and-fill-class-entries subjects-tree sessions-matrix data update-tree: #t)
				  (set! last-up currsec)







>







 







|
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>







 







>
>
>
>
>





|
|





|
|
|
|
|
|
|
|







 







<
<
<
<







 







>
>


|

>







 







>
>
>
>
>
>







 







|



|

|







 







|
|

|
>

<
>







 







|




|
|
>
>







 







>
>
>
>
>
>



|



|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


<
<
<
<

>










>
|
>







 







|











|
<







 







|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
...
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
...
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
...
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
...
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
...
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
...
632
633
634
635
636
637
638




639
640
641
642
643
644
645
...
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
...
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
...
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
...
792
793
794
795
796
797
798
799
800
801
802
803
804

805
806
807
808
809
810
811
812
...
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
...
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926




927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
...
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980

981
982
983
984
985
986
987
....
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
     (prefix iuputils  iuputils:)
     (prefix mtdb      mtdb:)
     (prefix iuputils  iuputils:)
     srfi-18 srfi-1
     iuputils
     call-with-environment-variables
     (prefix pkts pkts:)
     (prefix dbi dbi:)
     )

;; (use trace) ;; see trace at end of file

(defstruct learn-teach ;; rename this! it is confusing due to collision with module name!
  filters
  row-order
................................................................................
		 (tslot    . l)))    ;; reference to the time slot
    (vote     . ((app      . a)	     
		 (person   . p)      ;; whos vote is this
		 ;; (session  . s)      ;; to be implemented, for now store the Z of both subject and tslot
		 (tZ       . t)
		 (sZ       . s)
		 (vote     . v)      ;; 0 or 1 to vote against/for i.e. vote 0 to cancel previous vote of 1
		 ))                  ;; reference to the session pkt being voted for
    (del      . ((app      . a)
		 (person   . p)
		 (parent   . P)))))  ;; del applies to any parent pkt.
		 

(define learn-teach-pkts-dir (conc (current-directory) "/pkts"))

(if (not (directory-exists? learn-teach-pkts-dir))(create-directory learn-teach-pkts-dir #t))
	     
(define signal-reset-exception 
   (make-exception "Reset request recived." 'reset-request-exn))
................................................................................
		       learn-teach-pkts-dir
		       (lambda (pdb)
			 (pkts:find-pkts pdb '(subject) `((p . ,user-name)
							  ;; (a . "tnl")
							  )))))) ;; filter on subject and app. TODO, fix to use apkts and eliminate query based on key letters
    my-pkts))

(define (read-my-subjects-new user-name)
  (let ((my-pkts (pkts:with-queue-db
		       learn-teach-pkts-dir
		       (lambda (pdb)
			 (pkts:find-pkts pdb '(subject) `((p . ,user-name)
							  ;; (a . "tnl")
							  )
					 pkt-spec: pkt-spec))))) ;; filter on subject and app. TODO, fix to use apkts and eliminate query based on key letters
    my-pkts))

(define (get-subject-matching category subject level user-name)
  (let* ((subj-pkts (read-my-subjects-new user-name))
	 (res       #f))
    (if (null? subj-pkts)
	#f
	(let loop ((pkt  (car subj-pkts))
		   (tail (cdr subj-pkts)))
	  (let ((pcat  (alist-ref 'category pkt))
		(psubj (alist-ref 'name     pkt))
		(plevl (alist-ref 'level    pkt)))
	    (if (and (equal? category pcat)
		     (equal? subject  psubj)
		     (equal? level    plevl))
		pkt ;; return the pkt
		(if (null? tail)
		    #f
		    (loop (car tail)(cdr tail)))))))))

(define (read-time-slots)
  (pkts:with-queue-db
   learn-teach-pkts-dir
   (lambda (pdb)
     (pkts:find-pkts pdb '(tslot) `((a . "tnl")) pkt-spec: pkt-spec)))) ;; filter on tutor and app. TODO, fix to use apkts and eliminate query based on key letters

;; filter out past slots (or override with get-old to actually get the old slots)
................................................................................

(define (read-subjects)
  (pkts:with-queue-db
   learn-teach-pkts-dir
   (lambda (pdb)
     (pkts:find-pkts pdb '(subject) `((a . "tnl")))))) ;; filter on subject and app. TODO, fix to use apkts and eliminate query based on key letters

(define (read-subjects-new)
  (pkts:with-queue-db
   learn-teach-pkts-dir
   (lambda (pdb)
     (pkts:find-pkts pdb '(subject)
		     `((a . "tnl"))
		     pkt-spec: pkt-spec)))) ;; filter on subject and app. TODO, fix to use apkts and eliminate query based on key letters

;; tZ and sZ are the Z values of the two pkts
;;
(define (get-votes sZ tZ)
  ;; (print "sZ: " sZ " tZ: " tZ)
  (pkts:with-queue-db
   learn-teach-pkts-dir
   (lambda (pdb)
................................................................................
;;
(define (calc-total-votes avotes)
  (apply + (map (lambda (x)(or x 0))(hash-table-values avotes))))

;; (use trace)
;; (trace-call-sites #t)
;; (trace pkts:dpkt->alist)

;; apply del pkts
;;
(define (apply-del-pkts)
  (let ((del-pkts (get-del-pkts)))
    (pkts:with-queue-db
     learn-teach-pkts-dir
     (lambda (pdb)
       (for-each
	(lambda (P)
	  (dbi:exec pdb "DELETE FROM pkts WHERE uuid=?;" P)
	  (delete-file* (conc learn-teach-pkts-dir "/" P ".pkt"))
	  (print "Removed pkt " P ".pkt"))
	(map (lambda (x)
	       (alist-ref 'parent x)) ;; we are removing the PARENTS!
	     del-pkts))))))

(define (get-del-pkts)
  (let ((del-pkts (pkts:with-queue-db
		   learn-teach-pkts-dir
		   (lambda (pdb)
		     (pkts:find-pkts pdb '(del)
				     '()
				     pkt-spec:   pkt-spec
				     match-type: 'all)))))
    del-pkts))

;;======================================================================
;; Time and Date
;;======================================================================

(define std-time-def "%Y/%m/%d %H:%M %Z")

................................................................................
		  (get-and-fill-my-subjects my-subjects-tree my-subjects my-id data)
		  (for-each (lambda (x)
			      (iup:attribute-set! x "BGCOLOR" "255 255 255"))
			    (list level-edit-box subject-edit-box category-edit-box)))
		(iup:attribute-set! level-edit-box "BGCOLOR" "255 200 255"))
	    (iup:attribute-set! subject-edit-box "BGCOLOR" "255 200 255"))
	(iup:attribute-set! category-edit-box "BGCOLOR" "255 200 255"))))

(define (delete-category-subject my-subjects-tree my-subjects category-edit-box subject-edit-box level-edit-box details-edit-box data)
  (let* ((category (iup:attribute category-edit-box "VALUE"))
	 (subject  (iup:attribute subject-edit-box  "VALUE"))
	 (level    (iup:attribute level-edit-box    "VALUE"))
	 (details  (iup:attribute details-edit-box  "VALUE"))
	 (my-id    (get-my-id))
	 (pkt      (get-subject-matching category subject level my-id)))
    (if pkt
	(let* ((plist `((app      . "tnl")
			(person   . ,my-id)
			(parent   . ,(alist-ref 'Z pkt)))))
	  (pkts:write-alist->pkt learn-teach-pkts-dir plist pktspec: pkt-spec ptype: 'del)
	  (apply-del-pkts)
	  (load-pkts)
	  (get-and-fill-my-subjects my-subjects-tree my-subjects my-id data)))))

;; (use trace)(trace-call-sites #t)(trace delete-category-subject get-subject-matching pkts:write-alist->pkt apply-del-pkts)

(define (get-add-ht ht-in key)
  (let ((ht (hash-table-ref/default ht-in key #f)))
    (if ht
	ht
	(let ((ht (make-hash-table)))
	  (hash-table-set! ht-in key ht)
................................................................................
	      '(1 2 3 4 5 6 7 8 9 10 11))
    sessions-matrix))

;; Learn view panel
(defstruct vf
  (sZ         #f)
  (tZ         #f)
  (spkt       #f)
  (tpkt       #f)
  
  (data       #f)
  (datetime   (iup:label size: "120x" expand: "HORIZONTAL"))
  (day        (iup:label size: "120x" expand: "HORIZONTAL"))
  (category   (iup:label size: "120x" expand: "HORIZONTAL"))
  (subject    (iup:label size: "120x" expand: "HORIZONTAL"))
  (level      (iup:label size: "120x" expand: "HORIZONTAL"))
................................................................................
  (myvote     (iup:label size: "120x" expand: "HORIZONTAL"))
  (votebutton #f);; (iup:button "Yes"))
  (form       #f))

(define (heading-label val)
  (iup:label val size: "50x"))

(define-inline (set-label! lbl value)
  (iup:attribute-set! lbl "TITLE" (conc value))
  (iup:attribute-set! lbl "FGCOLOR" "055 155 055")
  (iup:attribute-set! lbl "REDRAW" "ALL")) ;; convert numbers, symbols etc. to strings

(define (setup-vote-form vf)
  (let ((btn (iup:button "Yes"
			 action: (lambda (obj)
				   (let* ((curr-val  (iup:attribute obj "TITLE"))
					  (new-vote  (if (equal? curr-val "Yes") 1 0)) ;; if Yes we are voting a 1, else vote a 0
					  ;; (new-title (if (eq? new-vote 1) "Yes" "No"))
					  ;; (new-btn-t (if (eq? new-vote 1) "No"  "Yes"))
					  (path      (cons "Subjects"
							   (map (lambda (x)
								  (iup:attribute x "TITLE"))
								(list (vf-category vf)(vf-subject vf)(vf-level vf)(vf-datetime vf)))))
					  ;; (path2     (append (take path 3)(list (conc (last path) " y"))))
					  ;; (data      (vf-data vf))
					  #; (new-tot   (conc ((if (eq? new-vote 1) + -)
							    (string->number (or (iup:attribute (vf-votes vf) "TITLE") "0"))
							    1)))
					  )
				     (set-vote (vf-data vf) new-vote (get-my-id)(vf-sZ vf)(vf-tZ vf) path)
				     (populate-vote-form vf #f (vf-spkt vf)(vf-tpkt vf))
				     )))))
    (vf-votebutton-set! vf btn)
    (vf-form-set!
     vf
     (iup:frame
      title: "Vote to attend a tutorial, change your vote with the button below."
      (iup:vbox
       (iup:gridbox
................................................................................
	(heading-label "Confirmed?")  (vf-state       vf)     (heading-label "Tot Votes:") (vf-votes    vf)
	(heading-label "My vote:")    (vf-myvote      vf))
       (iup:hbox (heading-label "Details:")   (or (vf-details  vf) ""))
       (iup:hbox
	(iup:label "Set your vote ") btn)))))
   vf)





(define (populate-vote-form vf data spkt tpkt) ;; sZ tZ datetime category subject level details instructor state data)
  (let* (;; spkt
	 (stype       (alist-ref 'pkt-type    spkt))  ;; subject
	 (sZ          (alist-ref 'Z           spkt))
	 (instructor  (alist-ref 'person      spkt))
	 (category    (alist-ref 'category    spkt))
	 (subject     (alist-ref 'name        spkt))
................................................................................
	 (weekday      (if date-timeval (time->day date-timeval) "-"))
	 (dispkey     (conc sZ "-" tZ))
	 (votes  (get-and-agregate-votes sZ tZ))
	 (tot    (calc-total-votes votes))
	 (my-id  (get-my-id))
	 (myvote (hash-table-ref/default votes my-id 0))
	 (btntitle (if (eq? myvote 0) "Yes" "No")))
    (vf-spkt-set! vf spkt)
    (vf-tpkt-set! vf tpkt)
    (vf-sZ-set! vf sZ)
    (vf-tZ-set! vf tZ)
    (if data (vf-data-set! vf data))
    (set-label! (vf-datetime   vf) datestr)
    (set-label! (vf-day        vf) weekday)
    (set-label! (vf-category   vf) category)
    (set-label! (vf-subject    vf) subject)
    (set-label! (vf-level      vf) level)
    (set-label! (vf-details    vf) details)
    (set-label! (vf-instructor vf) instructor)
    (set-label! (vf-state      vf) "-")
    (set-label! (vf-votes      vf) tot)
................................................................................
;;======================================================================
;; Main
;;======================================================================

(define (make-tab)
  (letrec* ((data               (make-hash-table)) ;; more flexible than a record, over time migrate items from this to defstructs
	    (bundle-filter-tb   (iup:textbox value: "%"  expand: "HORIZONTAL" action: (lambda (obj a b)(reset-request 'reset))))
	    (cfgdat             (let* ((c (read-learn-teach-config)) ;; load config and use this opportunity to process some settings
				       (df (configf:lookup c "settings" "default-font"))
				       (pd (configf:lookup c "settings" "pkts-dir")))
				  (if df (iup:attribute-set! #f "DEFAULTFONT" df))
				  (set! learn-teach-pkts-dir (or pd learn-teach-pkts-dir))
				  c))
	    ;;====================LEARN====================
	    (vote-form      (setup-vote-form (make-vf)))
	    (vote-btn       (vf-votebutton vote-form))
	    (subjects-tree  (iup:treebox
			     #:value 0
			     #:title "Subjects" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."
			     #:expand "YES"
................................................................................
				       ;; redirect to the form
				       (populate-vote-form vote-form data spkt tpkt) ;; sZ tZ datestr category subject level details tutor "-" data)
				       )
				 path))))
	    (sessions-matrix  (let* ((headings '("Id" "TZ" "Year/Month/Day" "Week Day" "Time" "  Subject  " "Level" "Instructor" "Confirmed" "Votes" "My vote" "           Details           " ))
				     (sm (iup:matrix
					  #:alignment1 "ALEFT"
					  ;; #:expand "YES" ;; "HORIZONTAL"
					  #:resizematrix "YES"
					  #:scrollbar "YES"
					  #:numcol (- (length headings) 1) ;; zeroth column (row header) is not counted.
					  #:numlin 50
					  ;; #:numcol-visible 8 ;; (min 8)
					  #:numlin_visible 8
					  #:click-cb
					  (lambda (mobj row col status)
					    (cond
					     ((eq? col 0) #f) ;; do stuff for column 0 click
					     ((and (> col 0)(> row 0)) ;;any column
					      (letrec* ((combos    (get-add-ht data 'displayed-combos))
							(info      (reverse-lookup-hash-table combos row))
................................................................................
				       expand: "HORIZONTAL")
			    (iup:split
			     #:orientation "VERTICAL"
			     #:value 100
			     (iup:frame
			      title: "Browse All Subjects and Times"
			      subjects-tree)
			     ;; (iup:frame
			     ;;  title: "Vote for a subject/time combination"
			      (iup:vbox
			       (vf-form vote-form)
			       (iup:label "Sessions with one or more votes:")
			       sessions-matrix

			       ) ;; )
			     )))
	    ;;====================TEACH====================
	    (my-subjects-tree  (iup:treebox
				#:value 0
				;; #:name "Subjects"
				#:title "Subjects" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."
				#:expand "YES"
................................................................................
				    (if (> plen 1)(iup:attribute-set! category-edit-box "VALUE" (cadr path))) ;; have at least the category
				    (if (> plen 2)(iup:attribute-set! subject-edit-box  "VALUE" (caddr path))) ;; have at least the category
				    (if (> plen 3)(iup:attribute-set! level-edit-box    "VALUE" (cadddr path))) ;; have at least the category
				    path))))
	    (time-slots   (get-and-fill-time-slots
			   (gui:fill-matrix-headings
			    (iup:matrix
			     ;; #:expand "YES"
			     #:alignment "ALEFT"
			     #:resizematrix "YES"
			     #:scrollbar "YES"
			     #:numcol 3
			     #:numlin 20
			     #:numlin-visible "8"
			     #:click-cb (lambda (obj row col value) #f)
			     )
			    '("Id" "Date" "Time" "Week Day")
			    fit-text: #t)
			   (current-user-name)))
	    (update-day     (lambda (obj cnum val)(print "Got day=" val)))
	    (update-time    (lambda (obj cnum val)
			      (iup:attribute-set! time-edit-box "BGCOLOR"
						  (if (valid-time val)
................................................................................
			       (iup:label "Day:"   Size: "30x16" )   day-edit-box (iup:label "(mon,tue,wed,thu,fri,sat,sun)" expand: "HORIZONTAL")
			       (iup:label "TZone:" Size: "30x16" ) tzone-edit-box (iup:label "(Three letter timezone code)"  expand: "HORIZONTAL"))
			      ;; (iup:label "")
			      (iup:hbox
			       (iup:button "Add"     action: add-time-slot    expand: "HORIZONTAL") ;; "YES")
			       (iup:button "Delete"  action: delete-time-slot expand: "HORIZONTAL")) ;; "YES"))
			      )))
	    ;; boxes for editing subjects
	    (subj-id-edit-box  (iup:textbox expand: "HORIZONTAL"))
	    (category-edit-box (iup:textbox expand: "HORIZONTAL"))
	    (subject-edit-box  (iup:textbox expand: "HORIZONTAL"))
	    (level-edit-box    (iup:textbox expand: "HORIZONTAL"))
	    (details-edit-box  (iup:textbox expand: "HORIZONTAL" multiline: "YES" size: "50x10"))
	    (my-subjects   (gui:fill-matrix-headings
			    (iup:matrix
			     #:alignment "ALEFT"
			     ;; #:expand "YES"
			     #:resizematrix "YES"
			     #:scrollbar "YES"
			     #:numcol 4
			     #:numlin 20
			     #:click-cb
			     (lambda (mobj row col status)
			       (cond
				;; ((eq? col 0) #f) ;; do stuff for column 0 click
				((and (>= col 0)(> row 0)) ;;any column
				 (let* ((category (iup:attribute mobj (conc row ":1")))
					(subject  (iup:attribute mobj (conc row ":2")))
					(level    (iup:attribute mobj (conc row ":3")))
					(my-id    (get-my-id))
					(my-subjs (read-my-subjects-new my-id)))
				   ;; (print "category: " category " subject: " subject " level: " level)
				   (for-each
				    (lambda (pkt)
				      (let ((pcat  (alist-ref 'category pkt))
					    (psubj (alist-ref 'name     pkt))
					    (plevl (alist-ref 'level    pkt)))
					;; (print "pcat: " pcat " psubj: " psubj " plevl: " plevl)
					(when (and (equal? category pcat)
						   (equal? subject  psubj)
						   (equal? level    plevl))
					  (iup:attribute-set! subj-id-edit-box  "VALUE" (alist-ref 'Z pkt))
					  (iup:attribute-set! category-edit-box "VALUE" pcat)
					  (iup:attribute-set! subject-edit-box  "VALUE" psubj)
					  (iup:attribute-set! level-edit-box    "VALUE" plevl)
					  )))
				    my-subjs)))))
			     )
			    '("Id" "Category" "Subject" "Level" "Details" "")
			    fit-text: #t))




	    (add-category-subject (lambda (obj)(save-category-subject my-subjects-tree my-subjects category-edit-box subject-edit-box level-edit-box details-edit-box data)))
	    (del-category-subject (lambda (obj)(delete-category-subject my-subjects-tree my-subjects category-edit-box subject-edit-box level-edit-box details-edit-box data)))
	    (add/edit-subject (iup:frame
			       title: "Add/Edit Subject"
			       (iup:vbox
				(iup:gridbox
				 numdiv: 2
				 expand: "YES"
				 (iup:label "Category:" size: "40x16") category-edit-box
				 (iup:label "Subject:"  size: "40x16") subject-edit-box
				 (iup:label "Level:"    size: "40x16") level-edit-box
				 (iup:label "Details:"  size: "40x16") details-edit-box )
				(iup:hbox
				 (iup:button "Add" action: add-category-subject expand: "HORIZONTAL")
				 (iup:button "Del" action: del-category-subject expand: "HORIZONTAL")))))
	    (teach         (iup:hbox
			    (iup:split
			     #:orientation "VERTICAL"
			     ;; #:value 00  ;; aprox 50%
			     (iup:frame
			      ;; (iup:label  "Enter the Subjects You Teach" expand: "HORIZONTAL" fontsize: "13" alignment: "ACENTER")
			      title:  "      Add Subjects You Teach" fontsize: "13"
................................................................................
			      ;; (iup:label  "Specify Your Time Slots" expand: "HORIZONTAL" fontsize: "13" alignment: "ACENTER")
			      title: "      Specify Your Time Slots" fontsize: "13"
			      (iup:vbox
			       time-slots
			       add/edit-slot)))
			    ))
	    (help          (help-drawing))
	    (config        (make-config-tab cfgdat))
	    (gui           (let ((side-tabs (iup:tabs
					     #:tabtype "LEFT"
					     (car help)
					     learn
					     teach
					     config
					     )))
			     (iup:attribute-set! side-tabs "TABTITLE0" "Help")
			     (iup:attribute-set! side-tabs "TABTITLE1" "Learn")
			     (iup:attribute-set! side-tabs "TABTITLE2" "Teach")
			     (iup:attribute-set! side-tabs "TABTITLE3" "Config")
			     side-tabs)) 

	    (mydata       #f) ;; hash table with pointers to all the stuff we need to keep track of, could use a struct but not sure I can safely test it for being compatible
	    (learn-teach-dat (make-learn-teach ;; we store the state private to this tab in here
			      ;; top-controls:  top-controls
			      subjects-tree:   subjects-tree
			      sessions-matrix:  sessions-matrix
			      bundle-filter: bundle-filter-tb
			      config:        cfgdat
................................................................................
				    (hash-table-set! alldats mytabnum newdat)
				    (set! mydata newdat)
				    (hash-table-set! newdat 'areas (make-hash-table))))
				 ((not mydata) ;; have mydat but it is not available in mydata
				  ;; (print "INFO: save tab dat")
				  (set! mydata mydat)) ;; this will not ever get hit until there is a finder of shared dat
				 ;; refresh any needed area data if it has been more than 1 second since the last update
				 ((or (> tdelta 7) ;; minumum of every four seconds update the matrix
				      (hash-table-ref/default data 'need-redraw #f))
				  ;; (print "Got here")
				  ;; (print "INFO: update matrix curr " currsec " last " last-up " tdelta " tdelta)
				  ;; (update-matrix learn-teach-dat tdelta)
				  (load-pkts)
				  (get-and-fill-class-entries subjects-tree sessions-matrix data update-tree: #t)
				  (set! last-up currsec)

Changes to multiapp/src/gui.scm.

12
13
14
15
16
17
18


19
20
21
22




23
24
25
26
27
28
29
..
49
50
51
52
53
54
55




































56




































(declare (unit gui))


(module gui
    (
     main-menu
     fill-matrix-headings


     )

(import scheme chicken data-structures)
(use (prefix iup iup:) canvas-draw pkts posix vg)





(define (main-menu curr-obj)
  (iup:menu
   (iup:menu-item "File" (iup:menu
			  (iup:menu-item
			   "Open"
			   action: (lambda (obj)
................................................................................
				(conc num ":0"))
			val)
    (if (and fit-text (eq? mode 'column))
	(iup:attribute-set! mtx "FITTOTEXT" (conc "C" num)))
    (if (not (null? tal))(loop (+ num 1)(car tal)(cdr tal))))
  mtx)





































)











































>
>



|
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
(declare (unit gui))


(module gui
    (
     main-menu
     fill-matrix-headings
     fill-config-matrix
     update-cfgdat-from-matrix
     )

(import scheme chicken data-structures)
(use (prefix iup iup:)
     (prefix mtconfigf configf:)
     canvas-draw pkts posix vg matchable
     srfi-69
     regex)

(define (main-menu curr-obj)
  (iup:menu
   (iup:menu-item "File" (iup:menu
			  (iup:menu-item
			   "Open"
			   action: (lambda (obj)
................................................................................
				(conc num ":0"))
			val)
    (if (and fit-text (eq? mode 'column))
	(iup:attribute-set! mtx "FITTOTEXT" (conc "C" num)))
    (if (not (null? tal))(loop (+ num 1)(car tal)(cdr tal))))
  mtx)

;; fill a matrix given a known settings spec
;;    ( ( sectionname (varname1 default/#f dtype "description")
;;                      (varname2 ...                     )
;;                    ))
;;
;;   dtype is path, number, fontspec etc. and will be used to pull up best fill-in helper
;;
(define (fill-config-matrix mtx spec cfgdat)
  (let* ((row-num 1)
	 (inc-row (lambda ()(set! row-num (+ row-num 1))))
	 (seen    (make-hash-table)))
    (for-each
     (lambda (sectiondat)
       (let ((section (car sectiondat))
	     (vars    (cdr sectiondat)))
	 ;; set the section name
	 (if (not (hash-table-exists? seen section))
	     (begin
	       (iup:attribute-set! mtx (conc row-num ":2") (conc "[" section "]"))
	       (inc-row)))
	 (for-each
	  (lambda (vardat)
	    (match-let (((varname default datatype description) vardat))
	      (iup:attribute-set! mtx (conc row-num ":1") (conc varname))
	      (iup:attribute-set! mtx (conc row-num ":2") (or (configf:lookup cfgdat section varname)
							      default
							      ""))
	      (iup:attribute-set! mtx (conc row-num ":3") description)
	      (iup:attribute-set! mtx (conc row-num ":4") (conc datatype))
	      (inc-row)))
	  vars)))
     spec)
    (iup:attribute-set! mtx "FITTOTEXT" (conc "C" 1))
    (iup:attribute-set! mtx "FITTOTEXT" (conc "C" 2))
    (iup:attribute-set! mtx "FITTOTEXT" (conc "C" 3))
    mtx))

;; scan the matrix and add/modify vars in respective sections
;;
(define (update-cfgdat-from-matrix cfgdat mtx)
  (let ((notdef (lambda (x)(or (not x)(equal? x "")))) ;; cell is blank or not defined
	(defnd  (lambda (x)(and x (not (equal? x "")))))
	(getsec (lambda (x)
		  (let ((m (string-match "^\\[(.*)\\]\\s*$" x)))
		    (if m
			(cadr m)
			#f)))))
    (let loop ((row-num  1)
	       (section #f))
      (let* ((c1 (iup:attribute mtx (conc row-num ":1")))
	     (c2 (iup:attribute mtx (conc row-num ":2")))
	     (c3 (iup:attribute mtx (conc row-num ":3")))
	     (c4 (iup:attribute mtx (conc row-num ":4"))))
	(cond
	 ((and (notdef c1)
	       (notdef c3)) ;; this is almost certainly a section
	  (let ((sname (getsec c2)))
	    (if sname
		(loop (+ row-num 1) sname)
		(begin
		  (print "ERROR: wrong or unrecognised data in row " row-num)
		  (loop (+ row-num 1) section)))))
	 ((and section
	       (defnd c1)
	       (defnd c2)) ;; have section, var and a non-blank value
	  (configf:section-var-set! cfgdat section c1 c2)
	  (loop (+ row-num 1) section))
	 ((and (notdef c1)
	       (notdef c2)
	       (notdef c3)) ;; end of the road
	  cfgdat))))))
		
)