quick add and fixed entity pollution with lists

android/assets/dbsync.scm

@@ -105,6 +105,7 @@
           (entity-add-value-create! key type value)))
     (msg "done entity-set-value!")))
 
+
 (define (date-time->string dt)
   (string-append
    (number->string (list-ref dt 0)) "-"
@@ -120,23 +121,26 @@
         (table (get-current 'table #f))
         (type (get-current 'entity-type #f)))
     ;; standard bits
-    (entity-add-value-create! "user" "varchar" (get-current 'user-id "none"))
-    (entity-add-value-create! "time" "varchar" (date-time->string (date-time)))
-    (entity-add-value-create! "lat" "real" (car (get-current 'location '(0 0))))
-    (entity-add-value-create! "lon" "real" (cadr (get-current 'location '(0 0))))
-    (entity-add-value-create! "deleted" "int" 0)
-    (let ((values (get-current 'entity-values '())))
-      (cond
-       ((not (null? values))
-        (let ((r (insert-entity/get-unique
-                  db table type (get-current 'user-id "no id")
-                  values)))
-          (msg "inserted a " type)
-          (entity-reset!) r))
-       (else
-        (msg "no values to add as entity!") #f)))
-    ;; just to be on the safe side
-    (entity-reset!)))
+    (let ((r (entity-create! db table type (get-current 'entity-values '()))))
+      (entity-reset!) r)))
+
+
+(define (entity-create! db table entity-type ktv-list)
+  (let ((values
+         (append
+          (list
+           (ktv-create "user" "varchar" (get-current 'user-id "none"))
+           (ktv-create "time" "varchar" (date-time->string (date-time)))
+           (ktv-create "lat" "real" (car (get-current 'location '(0 0))))
+           (ktv-create "lon" "real" (cadr (get-current 'location '(0 0))))
+           (ktv-create "deleted" "int" 0))
+          ktv-list)))
+    (let ((r (insert-entity/get-unique
+              db table entity-type (get-current 'user-id "no id")
+              values)))
+      (msg "entity-create: " entity-type)
+      r)))
+
 
 (define (entity-update-values!)
   (let ((db (get-current 'db #f))
@@ -603,8 +607,8 @@
 
 (define (do-gps display-id key-prepend)
   (let ((loc (get-current 'location '(0 0))))
-    (entity-add-value-create! (string-append key-prepend "-lat") "real" (car loc))
-    (entity-add-value-create! (string-append key-prepend "-lon") "real" (cadr loc))
+    (entity-set-value! (string-append key-prepend "-lat") "real" (car loc))
+    (entity-set-value! (string-append key-prepend "-lon") "real" (cadr loc))
     (list
      (update-widget
       'text-view
@@ -641,9 +645,11 @@
        (mtext-lookup 'add-item-to-list)
        40 (layout 100 'wrap-content 1 'centre 5)
        (lambda ()
-         (entity-init! db table entity-type ktv-default)
-         (entity-add-value-create! "parent" "varchar" (parent-fn))
-         (entity-record-values!)
+         (entity-create!
+          db table entity-type
+          (ktvlist-merge
+           ktv-default
+           (list (ktv "parent" "varchar" (parent-fn)))))
          (list (update-list-widget db table entity-type edit-activity (parent-fn))))))
      (linear-layout
       (make-id (string-append entity-type "-list"))
@@ -686,7 +692,7 @@
        (lambda (v)
          (cond
           ((eqv? v 1)
-           (entity-add-value! "deleted" "int" 1)
+           (entity-set-value! "deleted" "int" 1)
            (entity-update-values!)
            (list (finish-activity 1)))
           (else

android/assets/eavdb.scm

@@ -66,6 +66,21 @@
      (msg "unsupported ktv type in ktv-eq?: " (ktv-type a))
      #f))))
 
+;; replace or insert a ktv
+(define (ktvlist-replace ktv ktvlist)
+  (cond
+   ((null? ktvlist)
+    (list ktv))
+   ((equal? (ktv-key (car ktvlist)) (ktv-key ktv))
+    (cons ktv (cdr ktvlist)))
+   (else (cons (car ktvlist) (ktvlist-replace ktv (cdr ktvlist))))))
+
+(define (ktvlist-merge a b)
+  (foldl
+   (lambda (ktv r)
+     (ktvlist-replace ktv r))
+   a b))
+
 ;; stringify based on type (for url)
 (define (stringify-value ktv)
   (cond

android/assets/starwisp.scm

@@ -85,7 +85,9 @@
    (list 'delete-are-you-sure (list "Are you sure you want to delete this?"))
    (list 'save-are-you-sure (list "Are you sure you want to save changes?"))
 
-   ;; filter
+   ;; individual filter
+   (list 'quick-name (list "New person name"))
+   (list 'quick-add (list "Quick add"))
    (list 'find-individual (list "Find individual"))
    (list 'filter (list "Filter"))
    (list 'off (list "Off" "Off" "Off"))
@@ -249,6 +251,48 @@
    (list 'sex (list "Sex"))
    ))
 
+(define individual-ktvlist
+  (list
+   (ktv-create "name" "varchar" (mtext-lookup 'default-individual-name))
+   (ktv-create "family" "varchar" (mtext-lookup 'default-family-name))
+   (ktv-create "photo-id" "varchar" (mtext-lookup 'default-photo-id))
+   (ktv-create "photo" "file" "none")
+   (ktv-create "tribe" "varchar" "none")
+   (ktv-create "subtribe" "varchar" "none")
+   (ktv-create "child" "int" 0)
+   (ktv-create "age" "int" 0)
+   (ktv-create "gender" "varchar" "Female")
+   (ktv-create "education" "varchar" "none")
+   (ktv-create "head-of-house" "varchar" "none")
+   (ktv-create "marital-status" "varchar" "none")
+   (ktv-create "times-married" "int" 0)
+   (ktv-create "id-spouse" "varchar" "none")
+   (ktv-create "children-living" "int" 0)
+   (ktv-create "children-dead" "int" 0)
+   (ktv-create "children-together" "int" 0)
+   (ktv-create "children-apart" "int" 0)
+   (ktv-create "residence-after-marriage" "varchar" "none")
+   (ktv-create "num-siblings" "int" 0)
+   (ktv-create "birth-order" "int" 0)
+   (ktv-create "length-time" "int" 0)
+   (ktv-create "place-of-birth" "varchar" "none")
+   (ktv-create "num-residence-changes" "int" 0)
+   (ktv-create "village-visits-month" "int" 0)
+   (ktv-create "village-visits-year" "int" 0)
+   (ktv-create "occupation" "varchar" "none")
+   (ktv-create "contribute" "int" 0)
+   (ktv-create "own-land" "int" 0)
+   (ktv-create "rent-land" "int" 0)
+   (ktv-create "hire-land" "int" 0)
+   (ktv-create "house-type" "varchar" "none")
+   (ktv-create "loan" "int" 0)
+   (ktv-create "earning" "int" 0)
+   (ktv-create "radio" "int" 0)
+   (ktv-create "tv" "int" 0)
+   (ktv-create "mobile" "int" 0)
+   (ktv-create "visit-market" "int" 0)
+   (ktv-create "town-sell" "int" 0)
+   ))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -664,47 +708,7 @@
     (build-list-widget
      db "sync" 'individuals "individual" "individual"
      (lambda () (get-current 'household #f))
-     (list
-      (ktv-create "name" "varchar" (mtext-lookup 'default-individual-name))
-      (ktv-create "family" "varchar" (mtext-lookup 'default-family-name))
-      (ktv-create "photo-id" "varchar" (mtext-lookup 'default-photo-id))
-      (ktv-create "photo" "file" "none")
-      (ktv-create "tribe" "varchar" "none")
-      (ktv-create "subtribe" "varchar" "none")
-      (ktv-create "child" "int" 0)
-      (ktv-create "age" "int" 0)
-      (ktv-create "gender" "varchar" "Female")
-      (ktv-create "education" "varchar" "none")
-      (ktv-create "head-of-house" "varchar" "none")
-      (ktv-create "marital-status" "varchar" "none")
-      (ktv-create "times-married" "int" 0)
-      (ktv-create "id-spouse" "varchar" "none")
-      (ktv-create "children-living" "int" 0)
-      (ktv-create "children-dead" "int" 0)
-      (ktv-create "children-together" "int" 0)
-      (ktv-create "children-apart" "int" 0)
-      (ktv-create "residence-after-marriage" "varchar" "none")
-      (ktv-create "num-siblings" "int" 0)
-      (ktv-create "birth-order" "int" 0)
-      (ktv-create "length-time" "int" 0)
-      (ktv-create "place-of-birth" "varchar" "none")
-      (ktv-create "num-residence-changes" "int" 0)
-      (ktv-create "village-visits-month" "int" 0)
-      (ktv-create "village-visits-year" "int" 0)
-      (ktv-create "occupation" "varchar" "none")
-      (ktv-create "contribute" "int" 0)
-      (ktv-create "own-land" "int" 0)
-      (ktv-create "rent-land" "int" 0)
-      (ktv-create "hire-land" "int" 0)
-      (ktv-create "house-type" "varchar" "none")
-      (ktv-create "loan" "int" 0)
-      (ktv-create "earning" "int" 0)
-      (ktv-create "radio" "int" 0)
-      (ktv-create "tv" "int" 0)
-      (ktv-create "mobile" "int" 0)
-      (ktv-create "visit-market" "int" 0)
-      (ktv-create "town-sell" "int" 0)
-      ))
+     individual-ktvlist)
 
     (delete-button))
    (lambda (activity arg)
@@ -1038,6 +1042,30 @@
    "individual-chooser"
    (build-activity
     (vert
+     (horiz
+      (medit-text 'quick-name "normal" (lambda (v) (set-current! 'chooser-quick-name v) '()))
+      (mbutton-scale
+       'quick-add
+       (lambda ()
+         (list
+          (alert-dialog
+           "quick-add-check"
+           (mtext-lookup 'add-are-you-sure)
+           (lambda (v)
+             (cond
+              ((eqv? v 1)
+               (set-current!
+                'choose-result
+                (entity-create!
+                 db "sync" "individual"
+                 (ktvlist-merge
+                  individual-ktvlist
+                  (list
+                   (ktv "name" "varchar" (get-current 'chooser-quick-name (mtext-lookup 'no-name)))
+                   (ktv "parent" "varchar" (get-current 'household #f))))))
+               (list (finish-activity 0))))))))))
+
+
      (linear-layout
       (make-id "choose-pics") 'vertical
       (layout 'fill-parent 'wrap-content 0.75 'centre 0)