Commit fb4b99fd authored by Dave Griffiths's avatar Dave Griffiths
Browse files

quick add and fixed entity pollution with lists

parent fad42368
...@@ -105,6 +105,7 @@ ...@@ -105,6 +105,7 @@
(entity-add-value-create! key type value))) (entity-add-value-create! key type value)))
(msg "done entity-set-value!"))) (msg "done entity-set-value!")))
(define (date-time->string dt) (define (date-time->string dt)
(string-append (string-append
(number->string (list-ref dt 0)) "-" (number->string (list-ref dt 0)) "-"
...@@ -120,23 +121,26 @@ ...@@ -120,23 +121,26 @@
(table (get-current 'table #f)) (table (get-current 'table #f))
(type (get-current 'entity-type #f))) (type (get-current 'entity-type #f)))
;; standard bits ;; standard bits
(entity-add-value-create! "user" "varchar" (get-current 'user-id "none")) (let ((r (entity-create! db table type (get-current 'entity-values '()))))
(entity-add-value-create! "time" "varchar" (date-time->string (date-time))) (entity-reset!) r)))
(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) (define (entity-create! db table entity-type ktv-list)
(let ((values (get-current 'entity-values '()))) (let ((values
(cond (append
((not (null? values)) (list
(let ((r (insert-entity/get-unique (ktv-create "user" "varchar" (get-current 'user-id "none"))
db table type (get-current 'user-id "no id") (ktv-create "time" "varchar" (date-time->string (date-time)))
values))) (ktv-create "lat" "real" (car (get-current 'location '(0 0))))
(msg "inserted a " type) (ktv-create "lon" "real" (cadr (get-current 'location '(0 0))))
(entity-reset!) r)) (ktv-create "deleted" "int" 0))
(else ktv-list)))
(msg "no values to add as entity!") #f))) (let ((r (insert-entity/get-unique
;; just to be on the safe side db table entity-type (get-current 'user-id "no id")
(entity-reset!))) values)))
(msg "entity-create: " entity-type)
r)))
(define (entity-update-values!) (define (entity-update-values!)
(let ((db (get-current 'db #f)) (let ((db (get-current 'db #f))
...@@ -603,8 +607,8 @@ ...@@ -603,8 +607,8 @@
(define (do-gps display-id key-prepend) (define (do-gps display-id key-prepend)
(let ((loc (get-current 'location '(0 0)))) (let ((loc (get-current 'location '(0 0))))
(entity-add-value-create! (string-append key-prepend "-lat") "real" (car loc)) (entity-set-value! (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 "-lon") "real" (cadr loc))
(list (list
(update-widget (update-widget
'text-view 'text-view
...@@ -641,9 +645,11 @@ ...@@ -641,9 +645,11 @@
(mtext-lookup 'add-item-to-list) (mtext-lookup 'add-item-to-list)
40 (layout 100 'wrap-content 1 'centre 5) 40 (layout 100 'wrap-content 1 'centre 5)
(lambda () (lambda ()
(entity-init! db table entity-type ktv-default) (entity-create!
(entity-add-value-create! "parent" "varchar" (parent-fn)) db table entity-type
(entity-record-values!) (ktvlist-merge
ktv-default
(list (ktv "parent" "varchar" (parent-fn)))))
(list (update-list-widget db table entity-type edit-activity (parent-fn)))))) (list (update-list-widget db table entity-type edit-activity (parent-fn))))))
(linear-layout (linear-layout
(make-id (string-append entity-type "-list")) (make-id (string-append entity-type "-list"))
...@@ -686,7 +692,7 @@ ...@@ -686,7 +692,7 @@
(lambda (v) (lambda (v)
(cond (cond
((eqv? v 1) ((eqv? v 1)
(entity-add-value! "deleted" "int" 1) (entity-set-value! "deleted" "int" 1)
(entity-update-values!) (entity-update-values!)
(list (finish-activity 1))) (list (finish-activity 1)))
(else (else
......
...@@ -66,6 +66,21 @@ ...@@ -66,6 +66,21 @@
(msg "unsupported ktv type in ktv-eq?: " (ktv-type a)) (msg "unsupported ktv type in ktv-eq?: " (ktv-type a))
#f)))) #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) ;; stringify based on type (for url)
(define (stringify-value ktv) (define (stringify-value ktv)
(cond (cond
......
...@@ -85,7 +85,9 @@ ...@@ -85,7 +85,9 @@
(list 'delete-are-you-sure (list "Are you sure you want to delete this?")) (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?")) (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 'find-individual (list "Find individual"))
(list 'filter (list "Filter")) (list 'filter (list "Filter"))
(list 'off (list "Off" "Off" "Off")) (list 'off (list "Off" "Off" "Off"))
...@@ -249,6 +251,48 @@ ...@@ -249,6 +251,48 @@
(list 'sex (list "Sex")) (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 @@ ...@@ -664,47 +708,7 @@
(build-list-widget (build-list-widget
db "sync" 'individuals "individual" "individual" db "sync" 'individuals "individual" "individual"
(lambda () (get-current 'household #f)) (lambda () (get-current 'household #f))
(list individual-ktvlist)
(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)
))
(delete-button)) (delete-button))
(lambda (activity arg) (lambda (activity arg)
...@@ -1038,6 +1042,30 @@ ...@@ -1038,6 +1042,30 @@
"individual-chooser" "individual-chooser"
(build-activity (build-activity
(vert (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 (linear-layout
(make-id "choose-pics") 'vertical (make-id "choose-pics") 'vertical
(layout 'fill-parent 'wrap-content 0.75 'centre 0) (layout 'fill-parent 'wrap-content 0.75 'centre 0)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment