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

small fixes

parent 22387655
...@@ -90,20 +90,21 @@ ...@@ -90,20 +90,21 @@
;; version to check the entity has the key ;; version to check the entity has the key
(define (entity-set-value! key type value) (define (entity-set-value! key type value)
(let ((existing-type (ktv-get-type (get-current 'entity-values '()) key))) ; (let ((existing-type (ktv-get-type (get-current 'entity-values '()) key)))
(if (equal? existing-type type) ; (if (equal? existing-type type)
(set-current! (set-current!
'entity-values 'entity-values
(ktv-set (ktv-set
(get-current 'entity-values '()) (get-current 'entity-values '())
(ktv key type value))) (ktv key type value)))
;; ;;
(begin ; (begin
(msg "entity-set-value! - adding new " key "of type" type "to entity") ; (msg "entity-set-value! - adding new " key "of type" type "to entity")
(entity-add-value-create! key type value))) ; (entity-add-value-create! key type value)))
;; save straight to local db every time ;; save straight to local db every time
;;(entity-update-single-value! (list key type value)) ;;(entity-update-single-value! (list key type value))
)) ;; )
)
(define (date-time->string dt) (define (date-time->string dt)
......
...@@ -53,7 +53,6 @@ ...@@ -53,7 +53,6 @@
;; (chop (1 2 3 4) 2) -> ((1 2) (3 4)) ;; (chop (1 2 3 4) 2) -> ((1 2) (3 4))
(define (chop l n) (define (chop l n)
(define (_ in out c) (define (_ in out c)
(display c)(newline)
(cond (cond
((null? in) out) ((null? in) out)
((zero? c) (_ (cdr in) (cons (list (car in)) out) (- n 1))) ((zero? c) (_ (cdr in) (cons (list (car in)) out) (- n 1)))
...@@ -791,7 +790,7 @@ ...@@ -791,7 +790,7 @@
((null? w) #f) ((null? w) #f)
;; drill deeper ;; drill deeper
((eq? (update-widget-token w) 'contents) ((eq? (update-widget-token w) 'contents)
(msg "updateing contents from callback") ;;(msg "updateing contents from callback")
(update-callbacks! (update-widget-value w))) (update-callbacks! (update-widget-value w)))
((eq? (update-widget-token w) 'grid-buttons) ((eq? (update-widget-token w) 'grid-buttons)
(add-callback! (callback (update-widget-id w) (add-callback! (callback (update-widget-id w)
...@@ -834,7 +833,7 @@ ...@@ -834,7 +833,7 @@
(define (update-dialogs! events) (define (update-dialogs! events)
(msg "update-dialogs" events) ;;(msg "update-dialogs" events)
(when (list? events) (when (list? events)
(for-each (for-each
(lambda (event) (lambda (event)
...@@ -850,7 +849,8 @@ ...@@ -850,7 +849,8 @@
(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")) ;;(msg "update-dialogs end")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
...@@ -879,7 +879,7 @@ ...@@ -879,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
...@@ -899,7 +899,7 @@ ...@@ -899,7 +899,7 @@
(update-callbacks! (list ret))) (update-callbacks! (list ret)))
(else (else
(update-dialogs! ret) (update-dialogs! ret)
(msg "top-callback inbetween") ;;(msg "top-callback inbetween")
(update-callbacks-from-update! ret))) (update-callbacks-from-update! ret)))
(send (scheme->json ret))))) (send (scheme->json ret)))))
...@@ -909,10 +909,10 @@ ...@@ -909,10 +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) ;;(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) ;;(msg cb)
(if (not cb) (if (not cb)
(msg "no widget" widget-id "found!") (msg "no widget" widget-id "found!")
(let ((events (let ((events
...@@ -938,7 +938,7 @@ ...@@ -938,7 +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) ;;(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))
......
...@@ -791,6 +791,7 @@ ...@@ -791,6 +791,7 @@
(list (list
(mbutton "pf-grpint-done" "Done" (mbutton "pf-grpint-done" "Done"
(lambda () (lambda ()
(msg "entity-record-values about to be called?")
(entity-record-values!) (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"
......
...@@ -65,6 +65,7 @@ ...@@ -65,6 +65,7 @@
;; add all the keys ;; add all the keys
(for-each (for-each
(lambda (ktv) (lambda (ktv)
(msg "inserting" ktv)
(insert-value db table id ktv dirty)) (insert-value db table id ktv dirty))
ktvlist) ktvlist)
......
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