large local db changes for parallel entity edits, review fixes

android/assets/dbsync.scm

@@ -59,60 +59,56 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; db abstraction
 
+;; entity set - for storing and adding to multiple entities in memory
+
+(define (es-search es type)
+  (cond
+    ((null? es) #f)
+    ((equal? (car (car es)) type) (car es))
+    (else (es-search (cdr es) type))))
+
+(define (es-add-entity es type ktv-list)
+  (cond
+    ((null? es) (list (list type ktv-list)))
+    ((equal? (car (car es)) type) (cons (list type ktv-list) (cdr es)))
+    (else (cons (car es) (es-add-entity (cdr es) type ktv-list)))))
+
+(define es '())
+
+(define (es-ktv-list)
+  (let ((type (get-current 'entity-type #f)))
+    (cond
+     ((not type) (msg "es-ktv-list: no current entity type") '())
+     (else
+      (let ((s (es-search es type)))
+        (cond
+         ((not s) (msg "es-ktv-list: no entity for type " type) '())
+         (else (cadr s))))))))
+
+;; initialise the entity in memory - ktv-list can be empty for a new one
 (define (entity-init! db table entity-type ktv-list)
-  (entity-reset!)
-  (entity-set! ktv-list)
+  (set! es (es-add-entity es entity-type ktv-list))
   (set-current! 'db db)
   (set-current! 'table table)
   (set-current! 'entity-type entity-type))
 
+;; init and immediately save the entity to the db
+;; means it gets a unique_id
 (define (entity-init&save! db table entity-type ktv-list)
   (entity-init! db table entity-type ktv-list)
   (let ((id (entity-create! db table entity-type ktv-list)))
-    (msg "1")
     (entity-set-value! "unique_id" "varchar" id)
-    (msg "2")
     id))
 
-;; store a ktv, replaces existing with same key
-;;(define (entity-add-value! key type value)
-;;  (set-current!
-;;   'entity-values
-;;   (ktv-set
-;;    (get-current 'entity-values '())
-;;    (ktv key type value))))
-
-(define (entity-add-value-create! key type value)
-  (msg "entity-add-value-create!" key type value)
-  (set-current!
-   'entity-values
-   (ktv-set
-    (get-current 'entity-values '())
-    (ktv key type value))))
-
-(define (entity-set! ktv-list)
-  (set-current! 'entity-values ktv-list))
-
+;; get value from current memory entity
 (define (entity-get-value key)
-  (ktv-get (get-current 'entity-values '()) key))
+  (ktv-get (es-ktv-list) key))
 
-;; version to check the entity has the key
+;; write value to memory entity
 (define (entity-set-value! key type value)
-;  (let ((existing-type (ktv-get-type (get-current 'entity-values '()) key)))
-;    (if (equal? existing-type type)
-        (set-current!
-         'entity-values
-         (ktv-set
-          (get-current 'entity-values '())
-          (ktv key type value)))
-        ;;
-;        (begin
-;          (msg "entity-set-value! - adding new " key "of type" type "to entity")
-;          (entity-add-value-create! key type value)))
-    ;; save straight to local db every time
-    ;;(entity-update-single-value! (list key type value))
-        ;;       )
-        )
+  (set! es (es-add-entity
+            es (get-current 'entity-type #f)
+            (ktv-set (es-ktv-list) (ktv key type value)))))
 
 (define (date-time->string dt)
   (string-append
@@ -123,16 +119,15 @@
    (substring (number->string (+ (list-ref dt 4) 100)) 1 3) ":"
    (substring (number->string (+ (list-ref dt 5) 100)) 1 3)))
 
-;; build entity from all ktvs, insert to db, return unique_id
+;; build new entity from all memory ktvs, insert to db, return unique_id
 (define (entity-record-values!)
   (let ((db (get-current 'db #f))
         (table (get-current 'table #f))
         (type (get-current 'entity-type #f)))
     ;; standard bits
-    (let ((r (entity-create! db table type (get-current 'entity-values '()))))
-      (entity-reset!) r)))
-
+    (entity-create! db table type (es-ktv-list))))
 
+;; used internally
 (define (entity-create! db table entity-type ktv-list)
   (msg "creating:" entity-type ktv-list)
   (let ((values
@@ -151,15 +146,13 @@
       (msg "entity-create: " entity-type)
       r)))
 
-
+;; updates existing db entity from memory values
 (define (entity-update-values!)
   (let ((db (get-current 'db #f))
         (table (get-current 'table #f)))
-    (msg "entity-update-values" db table)
-    (msg (get-current 'entity-values '()))
     ;; standard bits
-    (let ((values (get-current 'entity-values '()))
-          (unique-id (ktv-get (get-current 'entity-values '()) "unique_id")))
+    (let* ((values (es-ktv-list))
+           (unique-id (ktv-get values "unique_id")))
       (cond
        ((and unique-id (not (null? values)))
         (msg "entity-update-values inner" values)
@@ -170,11 +163,12 @@
        (else
         (msg "no values or no id to update as entity:" unique-id "values:" values))))))
 
+;; updates memory and writes a single value to the db
 (define (entity-update-single-value! ktv)
   (entity-set-value! (ktv-key ktv) (ktv-type ktv) (ktv-value ktv))
   (let ((db (get-current 'db #f))
         (table (get-current 'table #f))
-        (unique-id (ktv-get (get-current 'entity-values '()) "unique_id")))
+        (unique-id (ktv-get (es-ktv-list) "unique_id")))
     (cond
      (unique-id
       (update-entity db table (entity-id-from-unique db table unique-id) (list ktv)))
@@ -182,12 +176,6 @@
       (msg "no values or no id to update as entity:" unique-id "values:" ktv)))))
 
 
-(define (entity-reset!)
-  (set-current! 'entity-values '())
-  (set-current! 'db "reset")
-  (set-current! 'table "reset")
-  (set-current! 'entity-type "reset"))
-
 (define (assemble-array entities)
   (foldl
    (lambda (i r)

android/assets/mongoose.scm

@@ -426,7 +426,7 @@
           (date->string (date-minus-months (date-time) 6))))))
 
 
-(define (tri-state id text key)
+(define (tri-state entity-type id text key)
   (linear-layout
    (make-id "") 'vertical (layout 'fill-parent 'wrap-content '1 'centre 0) trans-col
    (list
@@ -438,6 +438,7 @@
        (lambda (v)
          (cond
           (v
+           (set-current! 'entity-type entity-type)
            (entity-set-value! key "varchar" "yes")
            (list
             (update-widget 'toggle-button (get-id (string-append id "-n")) 'checked 0)
@@ -451,6 +452,7 @@
        (lambda (v)
          (cond
           (v
+           (set-current! 'entity-type entity-type)
            (entity-set-value! key "varchar" "maybe")
            (list
             (update-widget 'toggle-button (get-id (string-append id "-y")) 'checked 0)
@@ -465,6 +467,7 @@
        (lambda (v)
          (cond
           (v
+           (set-current! 'entity-type entity-type)
            (entity-set-value! key "varchar" "no")
            (list
             (update-widget 'toggle-button (get-id (string-append id "-y")) 'checked 0)
@@ -619,12 +622,14 @@
      (mbutton "review-item-cancel" "Cancel" (lambda () (list (finish-activity 0))))
      (mbutton (string-append uid "-save") "Save"
               (lambda ()
-                (let ((new-entity (review-validate-contents uid (get-current 'entity-values '()))))
+                (let* ((values (es-ktv-list))
+                       (new-entity (review-validate-contents uid values)))
                   (cond
                    ((list? new-entity)
                     ;; replace with converted ids
-                    (set-current! 'entity-values new-entity)
-                    ;;(entity-update-values!)
+                    (set! es (es-add-entity es (get-current 'entity-type #f) new-entity))
+                    ;;(set-current! 'entity-values new-entity)
+                    (entity-update-values!)
                     (list (finish-activity 0)))
                    (else
                     (list
@@ -645,7 +650,7 @@
       (get-id "review-item-container")
       'contents
       (review-build-contents
-       uid (get-current 'entity-values '()))))))
+       uid (es-ktv-list))))))
 
 (define (review-update-list)
   (list
@@ -659,17 +664,32 @@
               (time (ktv-get entity "time"))
               (type (list-ref data 0))
               (uid (list-ref data 1)))
-         (if (or (equal? type "group-comp")
-                 (equal? type "pup-focal"))
-             (cons
-              (mbutton
-               (string-append "review-" uid)
-               (string-append type (if time (string-append "-" time) ""))
-               (lambda ()
-                 (set-current! 'review-collection uid)
-                 (entity-init! db "stream" type (get-entity-by-unique db "stream" uid))
-                 (list (start-activity "review-collection" 0 ""))))
-              r) r)))
+         (cond
+          ((or (equal? type "group-comp")
+               (equal? type "pup-focal"))
+           (cons
+            (mbutton
+             (string-append "review-" uid)
+             (string-append type (if time (string-append "-" time) ""))
+             (lambda ()
+               (set-current! 'review-collection uid)
+               (entity-init! db "stream" type (get-entity-by-unique db "stream" uid))
+               (list (start-activity "review-collection" 0 ""))))
+            r))
+          ((or (equal? type "group-interaction")
+               (equal? type "group-alarm")
+               (equal? type "group-move")
+               (equal? type "note"))
+           (cons
+            (mbutton
+             (string-append "review-" uid)
+             (string-append type (if time (string-append "-" time) ""))
+             (lambda ()
+               (entity-init! db "stream" type (get-entity-by-unique db "stream" uid))
+               (list (start-activity "review-item" 0 ""))))
+            r))
+          (else r))
+         ))
      '()
      (dirty-entities-for-review db "stream")))))
 
@@ -678,24 +698,21 @@
   (list
    (update-widget
     'linear-layout (get-id "review-list") 'contents
-    (foldl
-     (lambda (dirty-entity r)
+    (map
+     (lambda (dirty-entity)
        ;; consists of ((type,uid,dirty,version) (ktvlist))
        (let* ((data (car dirty-entity))
               (entity (cadr dirty-entity))
               (time (ktv-get entity "time"))
               (type (list-ref data 0))
               (uid (list-ref data 1)))
-         (if (equal? (ktv-get entity "parent") parent-uid)
-             (cons
-              (mbutton
-               (string-append "review-" uid)
-               (string-append type (if time (string-append "-" time) ""))
-               (lambda ()
-                 (entity-init! db "stream" type (get-entity-by-unique db "stream" uid))
-                 (list (start-activity "review-item" 0 ""))))
-              r) r)))
-     '()
+         (mbutton
+          (string-append "review-" uid)
+          (string-append type (if time (string-append "-" time) ""))
+          (lambda ()
+            (entity-init! db "stream" type (get-entity-by-unique db "stream" uid))
+            (list (start-activity "review-item" 0 ""))))
+         ))
      (dirty-entities-for-review-parent db "stream" parent-uid)))))
 
 

android/assets/starwisp.scm

@@ -89,6 +89,7 @@
      (build-grid-selector "pf-scan-close" "toggle" "Mongooses within 2m")
      (mbutton "pf-scan-done" "Done"
               (lambda ()
+                (set-current! 'entity-type "pup-focal-nearest")
                 (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
                 (entity-record-values!)
                 (list (replace-fragment (get-id "pf-top") "pf-timer"))))))
@@ -105,12 +106,14 @@
        "pf-scan-nearest" "single"
        (db-mongooses-by-pack-adults) #t
        (lambda (individual)
+         (set-current! 'entity-type "pup-focal-nearest")
          (entity-set-value! "id-nearest" "varchar" (ktv-get individual "unique_id"))
          (list)))
       (populate-grid-selector
        "pf-scan-close" "toggle"
        (db-mongooses-by-pack-adults) #t
        (lambda (individuals)
+         (set-current! 'entity-type "pup-focal-nearest")
          (entity-set-value! "id-list-close" "varchar" (assemble-array individuals))
          (list)))
       ))
@@ -132,11 +135,13 @@
       (mtext "text" "Food size")
       (mspinner "pf-pupfeed-size" list-sizes
                 (lambda (v)
+                  (set-current! 'entity-type "pup-focal-pupfeed")
                   (entity-set-value! "size" "varchar" (spinner-choice list-sizes v)) '())))
      (spacer 20)
      (horiz
       (mbutton "pf-pupfeed-done" "Done"
                (lambda ()
+                 (set-current! 'entity-type "pup-focal-pupfeed")
                  (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
                  (entity-record-values!)
                  (list (replace-fragment (get-id "event-holder") "events"))))
@@ -153,6 +158,7 @@
        "pf-pupfeed-who" "single"
        (db-mongooses-by-pack-adults) #t
        (lambda (individual)
+         (set-current! 'entity-type "pup-focal-pupfeed")
          (entity-set-value! "id-who" "varchar" (ktv-get individual "unique_id"))
          (list)))
       ))
@@ -170,11 +176,14 @@
      (horiz
       (mtext "text" "Food size")
       (mspinner "pf-pupfind-size" list-sizes
-                (lambda (v) (entity-set-value! "size" "varchar" (spinner-choice list-sizes v)) '())))
+                (lambda (v)
+                  (set-current! 'entity-type "pup-focal-pupfind")
+                  (entity-set-value! "size" "varchar" (spinner-choice list-sizes v)) '())))
      (spacer 20)
      (horiz
       (mbutton "pf-pupfind-done" "Done"
                (lambda ()
+                 (set-current! 'entity-type "pup-focal-pupfind")
                  (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
                  (entity-record-values!)
                  (list (replace-fragment (get-id "event-holder") "events"))))
@@ -206,11 +215,13 @@
       (mtext "text" "Type of care")
       (mspinner "pf-pupcare-type" list-pupcare-type
                (lambda (v)
+                 (set-current! 'entity-type "pup-focal-pupcare")
                  (entity-set-value! "type" "varchar" (spinner-choice list-pupcare-type v)) '())))
      (spacer 20)
      (horiz
       (mbutton "pf-pupcare-done" "Done"
                (lambda ()
+                 (set-current! 'entity-type "pup-focal-pupcare")
                  (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
                  (entity-record-values!)
                  (list (replace-fragment (get-id "event-holder") "events"))))
@@ -227,6 +238,7 @@
        "pf-pupcare-who" "single"
        (db-mongooses-by-pack-adults) #t
        (lambda (individual)
+         (set-current! 'entity-type "pup-focal-pupcare")
          (entity-set-value! "id-who" "varchar" (ktv-get individual "unique_id"))
          (list)))
       ))
@@ -250,26 +262,29 @@
         (mtext "" "Fighting over")
         (mspinner "pf-pupaggr-over" list-aggression-over
                   (lambda (v)
+                    (set-current! 'entity-type "pup-focal-pupaggr")
                     (entity-set-value! "over" "varchar" (spinner-choice list-aggression-over v)) '())))
        (vert
         (mtext "" "Level")
         (mspinner "pf-pupaggr-level" list-aggression-level
                   (lambda (v)
+                    (set-current! 'entity-type "pup-focal-pupaggr")
                     (entity-set-value! "level" "varchar" (spinner-choice list-aggression-level v)) '())))
 
-       (tri-state "pf-pupaggr-in" "Initiate?" "initiate")
+       (tri-state "pup-focal-pupaggr" "pf-pupaggr-in" "Initiate?" "initiate")
 
        ;(mtoggle-button "pf-pupaggr-in" "Initiate?"
        ;                (lambda (v)
        ;                  (entity-set-value! "initiate" "varchar" (if v "yes" "no")) '()))
 
 
-       (tri-state "pf-pupaggr-win" "Win?" "win")))
+       (tri-state "pup-focal-pupaggr" "pf-pupaggr-win" "Win?" "win")))
 
      (spacer 10)
      (horiz
       (mbutton "pf-pupaggr-done" "Done"
                (lambda ()
+                 (set-current! 'entity-type "pup-focal-pupaggr")
                  (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
                  (entity-record-values!)
                  (list (replace-fragment (get-id "event-holder") "events"))))
@@ -287,6 +302,7 @@
        "pf-pupaggr-partner" "single"
        (db-mongooses-by-pack) #t
        (lambda (individual)
+         (set-current! 'entity-type "pup-focal-pupaggr")
          (entity-set-value! "id-with" "varchar" (ktv-get individual "unique_id"))
          (list)))
       ))
@@ -310,16 +326,20 @@
         (mtext "text" "Outcome")
         (mspinner "gp-int-out" list-interaction-outcome
                   (lambda (v)
+                    (set-current! 'entity-type "group-interaction")
                     (entity-set-value! "outcome" "varchar" (spinner-choice list-interaction-outcome v)) '()))
         (mtext "text" "Duration")
         (edit-text (make-id "gp-int-dur") "" 30 "numeric" fillwrap
-                   (lambda (v) (entity-set-value! "duration" "int" (string->number v)) '()))))
+                   (lambda (v)
+                     (set-current! 'entity-type "group-interaction")
+                     (entity-set-value! "duration" "int" (string->number v)) '()))))
       (build-grid-selector "gp-int-pack" "single" "Other pack"))
      (linear-layout
       (make-id "") 'horizontal (layout 'fill-parent 80 '1 'left 0) trans-col
       (list
        (mbutton "pf-grpint-done" "Done"
                 (lambda ()
+                  (set-current! 'entity-type "group-interaction")
                   (entity-record-values!)
                   (list (replace-fragment (get-id "event-holder") "events"))))
        (mbutton "pf-grpint-cancel" "Cancel"
@@ -338,12 +358,14 @@
         "gp-int-pack" "single"
         (db-mongoose-packs) #f
         (lambda (pack)
+          (set-current! 'entity-type "group-interaction")
           (entity-set-value! "id-other-pack" "varchar" (ktv-get pack "unique_id"))
           (list)))
        (populate-grid-selector
         "gp-int-leader" "single"
         (db-mongooses-by-pack) #t
         (lambda (individual)
+          (set-current! 'entity-type "group-interaction")
           (entity-set-value! "id-leader" "varchar" (ktv-get individual "unique_id"))
           (list)))
        )))
@@ -368,13 +390,15 @@
         (mtext "text" "Cause")
         (mspinner "gp-alarm-cause" list-alarm-cause
                   (lambda (v)
+                    (set-current! 'entity-type "group-alarm")
                     (entity-set-value! "cause" "varchar" (spinner-choice list-alarm-cause v)) '())))
 
-       (tri-state "gp-alarm-join" "Did the others join in?" "others-join")))
+       (tri-state "group-alarm" "gp-alarm-join" "Did the others join in?" "others-join")))
 
      (horiz
       (mbutton "pf-grpalarm-done" "Done"
                (lambda ()
+                 (set-current! 'entity-type "group-alarm")
                  (entity-record-values!)
                  (list (replace-fragment (get-id "event-holder") "events"))))
       (mbutton "pf-grpalarm-cancel" "Cancel"
@@ -392,6 +416,7 @@
         "gp-alarm-caller" "single"
         (db-mongooses-by-pack) #t
         (lambda (individual)
+          (set-current! 'entity-type "group-alarm")
           (entity-set-value! "id-caller" "varchar" (ktv-get individual "unique_id"))
           (list))))
       ))
@@ -410,28 +435,39 @@
       (make-id "") 'horizontal (layout 'fill-parent 'wrap-content '1 'left 0) trans-col
       (list
        (medit-text "gp-mov-w" "Pack width" "numeric"
-                   (lambda (v) (entity-set-value! "pack-width" "int" (string->number v)) '()))
+                   (lambda (v)
+                     (set-current! 'entity-type "group-move")
+                     (entity-set-value! "pack-width" "int" (string->number v)) '()))
        (medit-text "gp-mov-l" "Pack depth" "numeric"
-                   (lambda (v) (entity-set-value! "pack-depth" "int" (string->number v)) '()))
+                   (lambda (v)
+                     (set-current! 'entity-type "group-move")
+                     (entity-set-value! "pack-depth" "int" (string->number v)) '()))
        (medit-text "gp-mov-c" "How many?" "numeric"
-                   (lambda (v) (entity-set-value! "pack-count" "int" (string->number v)) '()))))
+                   (lambda (v)
+                     (set-current! 'entity-type "group-move")
+                     (entity-set-value! "pack-count" "int" (string->number v)) '()))))
      (linear-layout
       (make-id "") 'horizontal (layout 'fill-parent 'wrap-content '1 'left 0) trans-col
       (list
        (vert
         (mtext "" "Direction")
         (mspinner "gp-mov-dir" list-move-direction
-                  (lambda (v) (entity-set-value! "direction" "varchar" (spinner-choice list-move-direction v))  '())))
+                  (lambda (v)
+                    (set-current! 'entity-type "group-move")
+                    (entity-set-value! "direction" "varchar" (spinner-choice list-move-direction v))  '())))
 
        (vert
         (mtext "" "Where to")
         (mspinner "gp-mov-to" list-move-to
-                  (lambda (v) (entity-set-value! "destination" "varchar" (spinner-choice list-move-to v))  '())))))
+                  (lambda (v)
+                    (set-current! 'entity-type "group-move")
+                    (entity-set-value! "destination" "varchar" (spinner-choice list-move-to v))  '())))))
 
      (spacer 20)
      (horiz
       (mbutton "pf-grpmov-done" "Done"
                (lambda ()
+                 (set-current! 'entity-type "group-move")
                  (entity-record-values!)
                  (list (replace-fragment (get-id "event-holder") "events"))))
       (mbutton "pf-grpalarm-cancel" "Cancel"
@@ -449,6 +485,7 @@
         "gp-mov-leader" "single"
         (db-mongooses-by-pack) #t
         (lambda (individual)
+          (set-current! 'entity-type "group-move")
           (entity-set-value! "id-leader" "varchar" (ktv-get individual "unique_id"))
           (list)))
        )))
@@ -465,11 +502,13 @@
      (mtitle "title" "Make a note")
      (edit-text (make-id "note-text") "" 30 "text" fillwrap
                 (lambda (v)
+                  (set-current! 'entity-type "note")
                   (entity-set-value! "text" "varchar" v)
                   '()))
      (horiz
       (mbutton "note-done" "Done"
                (lambda ()
+                 (set-current! 'entity-type "note")
                  (entity-record-values!)
                  (list (replace-fragment (get-id "event-holder") "events"))))
       (mbutton "note-cancel" "Cancel"
@@ -503,13 +542,17 @@
      (mtitle "title" "Start")
      (horiz
       (mtoggle-button "gc-start-main-obs" "I'm the main observer"
-                      (lambda (v) (entity-update-single-value!
-                                   (ktv "main-observer" "varchar" v)) '()))
+                      (lambda (v)
+                        (set-current! 'entity-type "group-comp")
+                        (entity-update-single-value!
+                         (ktv "main-observer" "varchar" v)) '()))
       (vert
        (mtext "" "Code")
        (edit-text (make-id "gc-start-code") "" 30 "numeric" fillwrap
-                  (lambda (v) (entity-update-values!
-                               (ktv "group-comp-code" "varchar" v)) '()))))
+                  (lambda (v)
+                    (set-current! 'entity-type "group-comp")
+                    (entity-update-values!
+                     (ktv "group-comp-code" "varchar" v)) '()))))
 
      (mtitle "title" "Weights")
      (build-grid-selector "gc-weigh-choose" "single" "Choose mongoose")
@@ -517,14 +560,17 @@
      (horiz
       (edit-text (make-id "gc-weigh-weight") "" 30 "numeric" fillwrap
                  (lambda (v)
+                   (set-current! 'entity-type "group-comp-weight")
                    (entity-update-single-value! (ktv "weight" "real" (string->number v)))
                    '()))
       (mtoggle-button "gc-weigh-accurate" "Accurate?"
                       (lambda (v)
+                        (set-current! 'entity-type "group-comp-weight")
                         (entity-update-single-value! (ktv "accurate" "int" (if v 1 0)))
                         '()))
       (mtoggle-button "gc-weigh-present" "Present but not weighed"
                       (lambda (v)
+                        (set-current! 'entity-type "group-comp-weight")
                         (entity-update-single-value! (ktv "present" "int" (if v 1 0)))
                         '()))
       )
@@ -532,6 +578,7 @@
 
      (next-button "gc-start-" "Go to pregnant females, have you finished here?" "gc-start" "gc-preg"
                   (lambda ()
+                    (set-current! 'entity-type "group-comp")
                     (entity-update-values!)
 
                     ;; reset main entity
@@ -552,7 +599,11 @@
                              (list (list "parent" "varchar" "=" (get-current 'group-composition-id #f)))))
                            )))
 
-                    (set-current! 'gc-not-present (invert-mongoose-selection (string-split-simple (entity-get-value "present") #\,)))
+                    (set-current!
+                     'gc-not-present
+                     (invert-mongoose-selection
+                      (string-split-simple
+                       (entity-get-value "present") #\,)))
 
                     '()))
      ))
@@ -678,6 +729,7 @@
         "gc-preg-choose" "toggle"
         (db-mongooses-by-pack-female) #f
         (lambda (individuals)
+          (set-current! 'entity-type "group-comp")
           (entity-update-single-value! (ktv "pregnant" "varchar" (assemble-array individuals)))
           (list)))
        )
@@ -701,14 +753,14 @@
        (mtext "" "Strength")
        (mspin