Commit 3964b835 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

spinner-other fixed

parent 7783bb0a
...@@ -145,13 +145,11 @@ ...@@ -145,13 +145,11 @@
(let ((db (get-current 'db #f)) (let ((db (get-current 'db #f))
(table (get-current 'table #f))) (table (get-current 'table #f)))
;; standard bits ;; standard bits
(let ((values (get-current 'entity-values '())) (let ((values (dbg (get-current 'entity-values '())))
(unique-id (ktv-get (get-current 'entity-values '()) "unique_id"))) (unique-id (ktv-get (get-current 'entity-values '()) "unique_id")))
(cond (cond
((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)
(msg "updated " unique-id)
(msg 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!)
) )
...@@ -177,8 +175,6 @@ ...@@ -177,8 +175,6 @@
(define url "http://192.168.2.1:8889/symbai?") (define url "http://192.168.2.1:8889/symbai?")
(msg "url")
(define (build-url-from-ktv ktv) (define (build-url-from-ktv ktv)
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) ":" (number->string (ktv-version ktv)) "=" (stringify-value-url ktv))) (string-append "&" (ktv-key ktv) ":" (ktv-type ktv) ":" (number->string (ktv-version ktv)) "=" (stringify-value-url ktv)))
...@@ -517,7 +513,14 @@ ...@@ -517,7 +513,14 @@
(spinner (make-id (string-append (symbol->string id) "-spinner")) (spinner (make-id (string-append (symbol->string id) "-spinner"))
(map mtext-lookup types) (map mtext-lookup types)
(layout 'wrap-content 'wrap-content 1 'centre 0) (layout 'wrap-content 'wrap-content 1 'centre 0)
(lambda (c) (fn c)))) (lambda (c)
(msg "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
(msg c)
(msg (length types))
;; dont call if set to "other"
(if (< c (- (length types) 1))
(fn c)
'()))))
(vert (vert
(mtext-scale 'other) (mtext-scale 'other)
(edit-text (make-id (string-append (symbol->string id) "-edit-text")) (edit-text (make-id (string-append (symbol->string id) "-edit-text"))
...@@ -537,7 +540,13 @@ ...@@ -537,7 +540,13 @@
(spinner (make-id (string-append (symbol->string id) "-spinner")) (spinner (make-id (string-append (symbol->string id) "-spinner"))
(map mtext-lookup types) (map mtext-lookup types)
(layout 'wrap-content 'wrap-content 1 'centre 0) (layout 'wrap-content 'wrap-content 1 'centre 0)
(lambda (c) (fn c))) (lambda (c)
(msg "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
(msg c)
(msg (length types))
;; dont call if set to "other"
(if (< c (- (length types) 1))
(fn c) '())))
(mtext-scale 'other) (mtext-scale 'other)
(edit-text (make-id (string-append (symbol->string id) "-edit-text")) (edit-text (make-id (string-append (symbol->string id) "-edit-text"))
"" 30 "normal" "" 30 "normal"
...@@ -582,7 +591,9 @@ ...@@ -582,7 +591,9 @@
(else (msg "mupdate-widget unhandled widget type" widget-type)))) (else (msg "mupdate-widget unhandled widget type" widget-type))))
(define (spinner-choice l i) (define (spinner-choice l i)
(symbol->string (list-ref l i))) (if (number? i)
(symbol->string (list-ref l i))
i))
(define (mupdate-spinner id-symbol key choices) (define (mupdate-spinner id-symbol key choices)
(let* ((val (entity-get-value key))) (let* ((val (entity-get-value key)))
...@@ -602,19 +613,23 @@ ...@@ -602,19 +613,23 @@
'selection 0))))))) 'selection 0)))))))
(define (mupdate-spinner-other id-symbol key choices) (define (mupdate-spinner-other id-symbol key choices)
(let* ((val (dbg (entity-get-value key)))) (let* ((val (entity-get-value key)))
(if (not val) (if (not val)
(update-widget 'spinner (list (update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner")) (get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection 0) 'selection 0))
(let ((index (index-find (string->symbol val) choices))) (let ((index (index-find (string->symbol val) choices)))
(if index (if index
(update-widget 'spinner (list (update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner")) (get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection index) 'selection index))
(update-widget 'edit-text (list
(get-id (string-append (symbol->string id-symbol) "-edit-text")) (update-widget 'spinner
'selection index)))))) (get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection (- (length choices) 1))
(update-widget 'edit-text
(get-id (string-append (symbol->string id-symbol) "-edit-text"))
'text val)))))))
;;;; ;;;;
;; (y m d h m s) ;; (y m d h m s)
...@@ -712,7 +727,6 @@ ...@@ -712,7 +727,6 @@
(or (ktv-get e "name") "Unamed item") (or (ktv-get e "name") "Unamed item")
40 (layout 'fill-parent 'wrap-content 1 'centre 5) 40 (layout 'fill-parent 'wrap-content 1 'centre 5)
(lambda () (lambda ()
(msg "sending start act" (ktv-get e "unique_id"))
(list (start-activity edit-activity 0 (ktv-get e "unique_id")))))) (list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
search-results))))) search-results)))))
...@@ -738,9 +752,9 @@ ...@@ -738,9 +752,9 @@
(lambda (e) (lambda (e)
(list (ktv-get e "name") (list (ktv-get e "name")
(ktv-get e "unique_id"))) (ktv-get e "unique_id")))
(dbg (db-filter-only db table entity-type (db-filter-only db table entity-type
(list) (list)
(list (list "name" "varchar")))))) (list (list "name" "varchar")))))
(define vowel (map symbol->string (list 'a 'e 'i 'o 'u))) (define vowel (map symbol->string (list 'a 'e 'i 'o 'u)))
......
...@@ -41,7 +41,7 @@ ...@@ -41,7 +41,7 @@
;; basic key/type/value structure ;; basic key/type/value structure
;; used for all data internally, and maps to the eavdb types ;; used for all data internally, and maps to the eavdb types
(define (ktv key type value) (list key type value -999)) (define (ktv key type value) (list key type value 0))
(define (ktv-with-version key type value version) (list key type value version)) (define (ktv-with-version key type value version) (list key type value version))
(define (ktv-create key type value) (list key type value 0)) (define (ktv-create key type value) (list key type value 0))
(define ktv-key car) (define ktv-key car)
......
...@@ -66,7 +66,7 @@ ...@@ -66,7 +66,7 @@
(define residence-list '(birthplace spouse-village)) (define residence-list '(birthplace spouse-village))
(define gender-list '(male female)) (define gender-list '(male female))
(define occupation-list '(agriculture gathering labour cows fishing other)) (define occupation-list '(agriculture gathering labour cows fishing other))
(define house-type-list '(concrete tin thatched)) (define house-type-list '(concrete tin thatched other))
(define social-types-list '(friendship knowledge prestige)) (define social-types-list '(friendship knowledge prestige))
(define social-relationship-list '(mother father sister brother spouse children co-wife spouse-mother spouse-father spouse-brother-wife spouse-sister-husband friend neighbour other)) (define social-relationship-list '(mother father sister brother spouse children co-wife spouse-mother spouse-father spouse-brother-wife spouse-sister-husband friend neighbour other))
...@@ -297,8 +297,6 @@ ...@@ -297,8 +297,6 @@
) )
(msg "one")
(define (build-activity . contents) (define (build-activity . contents)
(vert-fill (vert-fill
(relative (relative
...@@ -444,13 +442,10 @@ ...@@ -444,13 +442,10 @@
;; need to load from across entities, so need db, table ;; need to load from across entities, so need db, table
(define (update-person-selector db table id key) (define (update-person-selector db table id key)
(msg "update-person-selector" key)
(let ((entity-id (entity-get-value key))) (let ((entity-id (entity-get-value key)))
(msg "entity-id is" entity-id)
(let ((image-name (image/name-from-unique-id db table entity-id)) (let ((image-name (image/name-from-unique-id db table entity-id))
(id (get-id (string-append (symbol->string id) "-image"))) (id (get-id (string-append (symbol->string id) "-image")))
(text-id (get-id (string-append (symbol->string id) "-text")))) (text-id (get-id (string-append (symbol->string id) "-text"))))
(msg "image-name is" (cadr image-name) (image-invalid? (cadr image-name)))
(if (image-invalid? (cadr image-name)) (if (image-invalid? (cadr image-name))
(list (list
(update-widget 'image-view id 'image "face") (update-widget 'image-view id 'image "face")
...@@ -501,18 +496,19 @@ ...@@ -501,18 +496,19 @@
(entity-set-value! key "varchar" (get-current 'choose-result "not set")))) (entity-set-value! key "varchar" (get-current 'choose-result "not set"))))
(define (update-social-connection db table id key type request-code) (define (update-social-connection db table id key type request-code)
(msg "update-social-connection")
(let ((id-text (string-append (symbol->string id)))) (let ((id-text (string-append (symbol->string id))))
(append (append
(update-person-selector db table id key) (update-person-selector db table id key)
(mupdate-spinner-other
(string->symbol (string-append id-text "-relationship"))
(string-append key "-relationship")
social-relationship-list)
(mupdate-spinner-other
(string->symbol (string-append id-text "-residence"))
(string-append key "-residence")
social-residence-list)
(list (list
(mupdate-spinner-other
(string->symbol (string-append id-text "-relationship"))
(string-append key "-relationship")
social-relationship-list)
(mupdate-spinner-other
(string->symbol (string-append id-text "-residence"))
(string-append key "-residence")
social-residence-list)
(mupdate-spinner (mupdate-spinner
(string->symbol (dbg (string-append id-text "-strength"))) (string->symbol (dbg (string-append id-text "-strength")))
(string-append key "-strength") (string-append key "-strength")
...@@ -702,7 +698,6 @@ ...@@ -702,7 +698,6 @@
(set-current! 'activity-title "Household List") (set-current! 'activity-title "Household List")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(msg "rebuilding household list with" arg)
(list (update-list-widget (list (update-list-widget
db "sync" "household" "household" arg))) db "sync" "household" "household" arg)))
(lambda (activity) '()) (lambda (activity) '())
...@@ -837,7 +832,7 @@ ...@@ -837,7 +832,7 @@
(medit-text 'details-name "normal" (lambda (v) (entity-set-value! "name" "varchar" v) '())) (medit-text 'details-name "normal" (lambda (v) (entity-set-value! "name" "varchar" v) '()))
(medit-text 'details-family "normal" (lambda (v) (entity-set-value! "family" "varchar" v) '())) (medit-text 'details-family "normal" (lambda (v) (entity-set-value! "family" "varchar" v) '()))
(medit-text 'details-photo-id "normal" (lambda (v) (entity-set-value! "photo-id" "varchar" v) '())))) (medit-text 'details-photo-id "normal" (lambda (v) (entity-set-value! "photo-id" "varchar" v) '()))))
(mspinner-other 'tribe tribes-list (lambda (v) (msg "tribe now:" v) (entity-set-value! "tribe" "varchar" (spinner-choice tribes-list v)) '())) (mspinner-other 'tribe tribes-list (lambda (v) (entity-set-value! "tribe" "varchar" (spinner-choice tribes-list v)) '()))
(mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-set-value! "subtribe" "varchar" (spinner-choice subtribe-list v)) '())) (mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-set-value! "subtribe" "varchar" (spinner-choice subtribe-list v)) '()))
(horiz (horiz
(medit-text 'age "numeric" (lambda (v) (entity-set-value! "age" "int" v) '())) (medit-text 'age "numeric" (lambda (v) (entity-set-value! "age" "int" v) '()))
...@@ -850,13 +845,13 @@ ...@@ -850,13 +845,13 @@
(lambda (activity arg) (lambda (activity arg)
(append (append
(update-top-bar (entity-get-value "name") (entity-get-value "photo-id")) (update-top-bar (entity-get-value "name") (entity-get-value "photo-id"))
(mupdate-spinner-other 'tribe "tribe" tribes-list)
(mupdate-spinner-other 'sub-tribe "subtribe" subtribe-list)
(list (list
(mupdate 'edit-text 'details-name "name") (mupdate 'edit-text 'details-name "name")
(mupdate 'edit-text 'details-family "family") (mupdate 'edit-text 'details-family "family")
(mupdate 'edit-text 'details-photo-id "photo-id") (mupdate 'edit-text 'details-photo-id "photo-id")
(mupdate 'image-view 'photo "photo") (mupdate 'image-view 'photo "photo")
(mupdate-spinner-other 'tribe "tribe" tribes-list)
(mupdate-spinner-other 'sub-tribe "subtribe" subtribe-list)
(mupdate 'edit-text 'age "age") (mupdate 'edit-text 'age "age")
(mupdate-spinner 'gender "gender" gender-list) (mupdate-spinner 'gender "gender" gender-list)
(mupdate-spinner 'education "education" education-list) (mupdate-spinner 'education "education" education-list)
...@@ -938,8 +933,7 @@ ...@@ -938,8 +933,7 @@
(when (and (eqv? requestcode spouse-request-code) (when (and (eqv? requestcode spouse-request-code)
(get-current 'choose-result #f)) (get-current 'choose-result #f))
(update-entity db "sync" (entity-id-from-unique db "sync" (get-current 'choose-result #f)) (update-entity db "sync" (entity-id-from-unique db "sync" (get-current 'choose-result #f))
(list (ktv "id-spouse" "varchar" (entity-get-value "unique_id")))) (list (ktv "id-spouse" "varchar" (entity-get-value "unique_id")))))
(msg "done..."))
;; save and reinit otherwise we can get out of sync here with the spouse :/ ;; save and reinit otherwise we can get out of sync here with the spouse :/
(let ((unique-id (entity-get-value "unique_id"))) (let ((unique-id (entity-get-value "unique_id")))
...@@ -954,9 +948,6 @@ ...@@ -954,9 +948,6 @@
(build-activity (build-activity
(mspinner 'move-household '() (mspinner 'move-household '()
(lambda (v) (lambda (v)
(msg v)
(msg (number? v))
(msg (list-ref (get-current 'move-household-list '()) v))
(entity-set-value! (entity-set-value!
"parent" "varchar" "parent" "varchar"
(cadr (list-ref (get-current 'move-household-list '()) v))) (cadr (list-ref (get-current 'move-household-list '()) v)))
...@@ -1044,6 +1035,7 @@ ...@@ -1044,6 +1035,7 @@
(entity-init! db "sync" "individual" (get-entity-by-unique db "sync" (get-current 'individual #f))) (entity-init! db "sync" "individual" (get-entity-by-unique db "sync" (get-current 'individual #f)))
(append (append
(update-top-bar (entity-get-value "name") (entity-get-value "photo-id")) (update-top-bar (entity-get-value "name") (entity-get-value "photo-id"))
(mupdate-spinner-other 'house-type "house-type" house-type-list)
(list (list
(update-list-widget db "sync" "crop" "crop" (get-current 'individual #f)) (update-list-widget db "sync" "crop" "crop" (get-current 'individual #f))
(mupdate-spinner 'occupation "occupation" occupation-list) (mupdate-spinner 'occupation "occupation" occupation-list)
...@@ -1051,7 +1043,6 @@ ...@@ -1051,7 +1043,6 @@
(mupdate 'toggle-button 'own-land "own-land") (mupdate 'toggle-button 'own-land "own-land")
(mupdate 'toggle-button 'rent-land "rent-land") (mupdate 'toggle-button 'rent-land "rent-land")
(mupdate 'toggle-button 'hire-land "hire-land") (mupdate 'toggle-button 'hire-land "hire-land")
(mupdate-spinner-other 'house-type "house-type" house-type-list)
(mupdate 'edit-text 'loan "loan") (mupdate 'edit-text 'loan "loan")
(mupdate 'edit-text 'earning "earning") (mupdate 'edit-text 'earning "earning")
(mupdate 'toggle-button 'radio "radio") (mupdate 'toggle-button 'radio "radio")
...@@ -1178,7 +1169,6 @@ ...@@ -1178,7 +1169,6 @@
(set-current! 'activity-title "Individual social network") (set-current! 'activity-title "Individual social network")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(msg "wooooop")
(append (append
(update-top-bar (entity-get-value "name") (entity-get-value "photo-id")) (update-top-bar (entity-get-value "name") (entity-get-value "photo-id"))
(list (list
...@@ -1258,7 +1248,6 @@ ...@@ -1258,7 +1248,6 @@
(lambda (v) (lambda (v)
(cond (cond
((eqv? v 1) ((eqv? v 1)
(msg "adding new person quickly")
(set-current! (set-current!
'choose-result 'choose-result
(entity-create! (entity-create!
......
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