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 @@
(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 (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 type (get-current 'user-id "no id")
db table entity-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!)))
(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
......
......@@ -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
......
......@@ -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)
......
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