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

entity save/pup focal fixes

parent 470db9ef
...@@ -126,7 +126,7 @@ ...@@ -126,7 +126,7 @@
(define (entity-create! db table entity-type ktv-list) (define (entity-create! db table entity-type ktv-list)
;;(msg "creating:" entity-type ktv-list) (msg "creating:" entity-type ktv-list)
(let ((values (let ((values
(append (append
(list (list
...@@ -136,6 +136,7 @@ ...@@ -136,6 +136,7 @@
(ktv "lon" "real" (cadr (get-current 'location '(0 0)))) (ktv "lon" "real" (cadr (get-current 'location '(0 0))))
(ktv "deleted" "int" 0)) (ktv "deleted" "int" 0))
ktv-list))) ktv-list)))
(msg "about to insert")
(let ((r (insert-entity/get-unique (let ((r (insert-entity/get-unique
db table entity-type (get-current 'user-id "no id") db table entity-type (get-current 'user-id "no id")
values))) values)))
...@@ -153,7 +154,7 @@ ...@@ -153,7 +154,7 @@
((and unique-id (not (null? values))) ((and unique-id (not (null? values)))
(update-entity db table (entity-id-from-unique db table unique-id) values) (update-entity db table (entity-id-from-unique db table unique-id) values)
;; removed due to save button no longer exiting activity - need to keep! ;; removed due to save button no longer exiting activity - need to keep!
;;(entity-reset!) (entity-reset!)
) )
(else (else
(msg "no values or no id to update as entity:" unique-id "values:" values)))))) (msg "no values or no id to update as entity:" unique-id "values:" values))))))
......
...@@ -834,6 +834,7 @@ ...@@ -834,6 +834,7 @@
(define (update-dialogs! events) (define (update-dialogs! events)
(msg "update-dialogs" events)
(when (list? events) (when (list? events)
(for-each (for-each
(lambda (event) (lambda (event)
...@@ -848,7 +849,8 @@ ...@@ -848,7 +849,8 @@
(equal? (list-ref event 0) "walk-draggable") (equal? (list-ref event 0) "walk-draggable")
(equal? (list-ref event 0) "gps-start")) (equal? (list-ref event 0) "gps-start"))
(add-new-dialog! event))) (add-new-dialog! event)))
events))) events))
(msg "update-dialogs end"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
...@@ -877,7 +879,7 @@ ...@@ -877,7 +879,7 @@
r)) r))
(define (top-callback type activity-name activity args) (define (top-callback type activity-name activity args)
;;(display "activity/fragment-callback ")(display type)(display " ")(display args)(newline) (display "activity/fragment-callback ")(display type)(display " ")(display args)(newline)
(if (not activity) (if (not activity)
(begin (display "no activity/fragment called ")(display activity-name)(newline)) (begin (display "no activity/fragment called ")(display activity-name)(newline))
(let ((ret (cond (let ((ret (cond
...@@ -897,6 +899,7 @@ ...@@ -897,6 +899,7 @@
(update-callbacks! (list ret))) (update-callbacks! (list ret)))
(else (else
(update-dialogs! ret) (update-dialogs! ret)
(msg "top-callback inbetween")
(update-callbacks-from-update! ret))) (update-callbacks-from-update! ret)))
(send (scheme->json ret))))) (send (scheme->json ret)))))
...@@ -906,8 +909,10 @@ ...@@ -906,8 +909,10 @@
(activity-list-find fragments name)))) (activity-list-find fragments name))))
(define (widget-callback activity-name widget-id args) (define (widget-callback activity-name widget-id args)
(msg "widget-callback" activity-name widget-id args)
(prof-start "widget-callback") (prof-start "widget-callback")
(let ((cb (find-callback widget-id))) (let ((cb (find-callback widget-id)))
(msg cb)
(if (not cb) (if (not cb)
(msg "no widget" widget-id "found!") (msg "no widget" widget-id "found!")
(let ((events (let ((events
...@@ -933,6 +938,7 @@ ...@@ -933,6 +938,7 @@
;; this was just update-callbacks, commented out, ;; this was just update-callbacks, commented out,
;; expecting trouble here... (but seems to fix new widgets from ;; expecting trouble here... (but seems to fix new widgets from
;; widget callbacks so far) ;; widget callbacks so far)
(msg "callback returned" events)
(update-callbacks-from-update! events) (update-callbacks-from-update! events)
(update-dialogs! events) (update-dialogs! events)
(send (scheme->json events)) (send (scheme->json events))
......
...@@ -495,13 +495,13 @@ ...@@ -495,13 +495,13 @@
(mbutton "pf-scan-done" "Done" (mbutton "pf-scan-done" "Done"
(lambda () (lambda ()
(entity-set-value! "parent" "varchar" (get-current 'pup-focal-id "")) (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values! db "stream" "pup-focal-nearest") (entity-record-values!)
(list (replace-fragment (get-id "pf-top") "pf-timer")))))) (list (replace-fragment (get-id "pf-top") "pf-timer"))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "pup-focal-nearest" '())
(entity-set-value! "scan-time" "varchar" (date-time->string (date-time))) (entity-set-value! "scan-time" "varchar" (date-time->string (date-time)))
(list (list
(play-sound "ping") (play-sound "ping")
...@@ -543,7 +543,7 @@ ...@@ -543,7 +543,7 @@
(mbutton "pf-pupfeed-done" "Done" (mbutton "pf-pupfeed-done" "Done"
(lambda () (lambda ()
(entity-set-value! "parent" "varchar" (get-current 'pup-focal-id "")) (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values! db "stream" "pup-focal-pupfeed") (entity-record-values!)
(list (replace-fragment (get-id "event-holder") "events")))) (list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupfeed-cancel" "Cancel" (mbutton "pf-pupfeed-cancel" "Cancel"
(lambda () (lambda ()
...@@ -552,7 +552,7 @@ ...@@ -552,7 +552,7 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "pup-focal-pupfeed" '())
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupfeed-who" "single" "pf-pupfeed-who" "single"
...@@ -581,7 +581,7 @@ ...@@ -581,7 +581,7 @@
(mbutton "pf-pupfind-done" "Done" (mbutton "pf-pupfind-done" "Done"
(lambda () (lambda ()
(entity-set-value! "parent" "varchar" (get-current 'pup-focal-id "")) (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values! db "stream" "pup-focal-pupfind") (entity-record-values!)
(list (replace-fragment (get-id "event-holder") "events")))) (list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupfind-cancel" "Cancel" (mbutton "pf-pupfind-cancel" "Cancel"
(lambda () (lambda ()
...@@ -590,7 +590,7 @@ ...@@ -590,7 +590,7 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "pup-focal-pupfind" '())
(list (list
)) ))
(lambda (fragment) '()) (lambda (fragment) '())
...@@ -617,7 +617,7 @@ ...@@ -617,7 +617,7 @@
(mbutton "pf-pupcare-done" "Done" (mbutton "pf-pupcare-done" "Done"
(lambda () (lambda ()
(entity-set-value! "parent" "varchar" (get-current 'pup-focal-id "")) (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values! db "stream" "pup-focal-pupcare") (entity-record-values!)
(list (replace-fragment (get-id "event-holder") "events")))) (list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupcare-cancel" "Cancel" (mbutton "pf-pupcare-cancel" "Cancel"
(lambda () (lambda ()
...@@ -626,7 +626,7 @@ ...@@ -626,7 +626,7 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "pup-focal-pupcare" '())
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupcare-who" "single" "pf-pupcare-who" "single"
...@@ -676,7 +676,7 @@ ...@@ -676,7 +676,7 @@
(mbutton "pf-pupaggr-done" "Done" (mbutton "pf-pupaggr-done" "Done"
(lambda () (lambda ()
(entity-set-value! "parent" "varchar" (get-current 'pup-focal-id "")) (entity-set-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values! db "stream" "pup-focal-pupaggr") (entity-record-values!)
(list (replace-fragment (get-id "event-holder") "events")))) (list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupaggr-cancel" "Cancel" (mbutton "pf-pupaggr-cancel" "Cancel"
(lambda () (lambda ()
...@@ -686,7 +686,7 @@ ...@@ -686,7 +686,7 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "pup-focal-pupaggr" '())
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupaggr-partner" "single" "pf-pupaggr-partner" "single"
...@@ -725,7 +725,7 @@ ...@@ -725,7 +725,7 @@
(list (list
(mbutton "pf-grpint-done" "Done" (mbutton "pf-grpint-done" "Done"
(lambda () (lambda ()
(entity-record-values! db "stream" "group-interaction") (entity-record-values!)
(list (replace-fragment (get-id "event-holder") "events")))) (list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpint-cancel" "Cancel" (mbutton "pf-grpint-cancel" "Cancel"
(lambda () (lambda ()
...@@ -735,7 +735,7 @@ ...@@ -735,7 +735,7 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "group-interaction" '())
(append (append
(force-pause) (force-pause)
(list (list
...@@ -780,7 +780,7 @@ ...@@ -780,7 +780,7 @@
(horiz (horiz
(mbutton "pf-grpalarm-done" "Done" (mbutton "pf-grpalarm-done" "Done"
(lambda () (lambda ()
(entity-record-values! db "stream" "group-alarm") (entity-record-values!)
(list (replace-fragment (get-id "event-holder") "events")))) (list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpalarm-cancel" "Cancel" (mbutton "pf-grpalarm-cancel" "Cancel"
(lambda () (lambda ()
...@@ -789,7 +789,7 @@ ...@@ -789,7 +789,7 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "group-alarm" '())
(append (append
(force-pause) (force-pause)
(list (list
...@@ -837,7 +837,7 @@ ...@@ -837,7 +837,7 @@
(horiz (horiz
(mbutton "pf-grpmov-done" "Done" (mbutton "pf-grpmov-done" "Done"
(lambda () (lambda ()
(entity-record-values! db "stream" "group-move") (entity-record-values!)
(list (replace-fragment (get-id "event-holder") "events")))) (list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpalarm-cancel" "Cancel" (mbutton "pf-grpalarm-cancel" "Cancel"
(lambda () (lambda ()
...@@ -846,7 +846,7 @@ ...@@ -846,7 +846,7 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "group-move" '())
(append (append
(force-pause) (force-pause)
(list (list
...@@ -875,17 +875,16 @@ ...@@ -875,17 +875,16 @@
(horiz (horiz
(mbutton "note-done" "Done" (mbutton "note-done" "Done"
(lambda () (lambda ()
(entity-record-values! db "stream" "note") (entity-record-values!)
(list (replace-fragment (get-id "event-holder") "events")))) (list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "note-cancel" "Cancel" (mbutton "note-cancel" "Cancel"
(lambda () (lambda ()
(entity-reset!)
(list (replace-fragment (get-id "event-holder") "events"))))))) (list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "note" '())
(append (append
(force-pause) (force-pause)
(list (list
...@@ -957,8 +956,8 @@ ...@@ -957,8 +956,8 @@
(msg "saving to " (get-current 'entity-id "0")) (msg "saving to " (get-current 'entity-id "0"))
(if (get-current 'updating #f) (if (get-current 'updating #f)
(entity-update-values! db "stream") (entity-update-values! db "stream")
(entity-record-values! db "stream" "weight") (entity-record-values!)
(entity-reset!) (entity-init! db "stream" "weight" '())
'())))) '()))))
(mtoggle-button "gc-weigh-accurate" "Accurate?" (lambda (v) '())) (mtoggle-button "gc-weigh-accurate" "Accurate?" (lambda (v) '()))
...@@ -968,7 +967,7 @@ ...@@ -968,7 +967,7 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-init! db "stream" "weight" '())
(list (list
(populate-grid-selector (populate-grid-selector
"gc-weigh-choose" "single" "gc-weigh-choose" "single"
...@@ -1178,22 +1177,25 @@ ...@@ -1178,22 +1177,25 @@
(lambda (v) (lambda (v)
(set-current! 'user-id v) (set-current! 'user-id v)
(update-entity (update-entity
db "local" 1 (list (ktv "user-id" "varchar" v))))) db "local" 1 (list (ktv "user-id" "varchar" v)))
'()))
(mtext "foo" "Database") (mtext "foo" "Database")
(mbutton2 "main-sync" "Sync database" (lambda () (list (start-activity "sync" 0 ""))))) (mbutton2 "main-sync" "Sync database" (lambda () (list (start-activity "sync" 0 "")))))
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(msg "on-start")
(setup-database!) (setup-database!)
(let ((user-id (ktv-get (get-entity db "local" 1) "user-id"))) (let ((user-id (ktv-get (get-entity db "local" 1) "user-id")))
(set-current! 'user-id user-id) (set-current! 'user-id user-id)
(list (msg "on-start 2")
(gps-start "gps" (lambda (loc) (dbg (list
(gps-start "gps" (lambda (loc)
(set-current! 'location loc) (set-current! 'location loc)
(list (toast (string-append (list (toast (string-append
(number->string (car loc)) ", " (number->string (car loc)) ", "
(number->string (cadr loc))))))) (number->string (cadr loc)))))))
(update-widget 'edit-text (get-id "main-id-text") 'text user-id)))) (update-widget 'edit-text (get-id "main-id-text") 'text user-id)))))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -1328,7 +1330,7 @@ ...@@ -1328,7 +1330,7 @@
(lambda () (lambda ()
(cond (cond
((current-exists? 'individual) ((current-exists? 'individual)
(set-current! 'pup-focal-id (entity-record-values! db "stream" "pup-focal")) (set-current! 'pup-focal-id (entity-record-values!))
(set-current! 'timer-minutes pf-length) (set-current! 'timer-minutes pf-length)
(set-current! 'timer-seconds 0) (set-current! 'timer-seconds 0)
(list (list
...@@ -1343,7 +1345,7 @@ ...@@ -1343,7 +1345,7 @@
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(entity-reset!) (entity-init! db "stream" "pup-focal" '())
(list (list
(populate-grid-selector (populate-grid-selector
"pf1-grid" "single" "pf1-grid" "single"
...@@ -1471,16 +1473,17 @@ ...@@ -1471,16 +1473,17 @@
(spacer 10) (spacer 10)
(horiz (horiz
(mbutton2 "new-pack-cancel" "Cancel" (mbutton2 "new-pack-cancel" "Cancel"
(lambda () (entity-reset!) (list (finish-activity 2)))) (lambda ()
(list (finish-activity 2))))
(mbutton2 "new-pack-done" "Done" (mbutton2 "new-pack-done" "Done"
(lambda () (lambda ()
(entity-record-values! db "sync" "pack") (entity-record-values!)
(list (finish-activity 2))))) (list (finish-activity 2)))))
) )
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(entity-reset!) (entity-init! db "sync" "pack" '())
(list)) (list))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -1555,17 +1558,17 @@ ...@@ -1555,17 +1558,17 @@
(lambda (v) (entity-set-value! "chip-code" "varchar" v) '())) (lambda (v) (entity-set-value! "chip-code" "varchar" v) '()))
(horiz (horiz
(mbutton2 "new-individual-cancel" "Cancel" (mbutton2 "new-individual-cancel" "Cancel"
(lambda () (entity-reset!) (list (finish-activity 2)))) (lambda () (list (finish-activity 2))))
(mbutton2 "new-individual-done" "Done" (mbutton2 "new-individual-done" "Done"
(lambda () (lambda ()
(entity-set-value! "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id")) (entity-set-value! "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(entity-record-values! db "sync" "mongoose") (entity-record-values!)
(list (finish-activity 2))))) (list (finish-activity 2)))))
) )
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(entity-reset!) (entity-init! db "sync" "mongoose" '())
;; make sure all fields exist ;; make sure all fields exist
(entity-set-value! "name" "varchar" "noname") (entity-set-value! "name" "varchar" "noname")
(entity-set-value! "gender" "varchar" "Female") (entity-set-value! "gender" "varchar" "Female")
...@@ -1630,17 +1633,17 @@ ...@@ -1630,17 +1633,17 @@
(list)))) (list))))
(horiz (horiz
(mbutton2 "update-individual-cancel" "Cancel" (mbutton2 "update-individual-cancel" "Cancel"
(lambda () (entity-reset!) (list (finish-activity 2)))) (lambda () (list (finish-activity 2))))
(mbutton2 "update-individual-done" "Done" (mbutton2 "update-individual-done" "Done"
(lambda () (lambda ()
(entity-update-values! db "sync") (entity-update-values!)
(list (finish-activity 2))))) (list (finish-activity 2)))))
) )
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(entity-reset!) (entity-init! db "sync" "individual"
(entity-set! (get-current 'individual '())) (get-entity-by-unique db "sync" (get-current 'individual #f)))
(let ((individual (get-current 'individual '()))) (let ((individual (get-current 'individual '())))
(msg "deleted = " (ktv-get individual "deleted")) (msg "deleted = " (ktv-get individual "deleted"))
(list (list
......
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