Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
nebogeo
symbai
Commits
0116bda6
Commit
0116bda6
authored
Mar 27, 2014
by
Dave Griffiths
Browse files
partial filtering fix
parent
2b2c447e
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
64 additions
and
22 deletions
+64
-22
android/assets/eavdb.scm
android/assets/eavdb.scm
+33
-5
android/assets/starwisp.scm
android/assets/starwisp.scm
+31
-17
No files found.
android/assets/eavdb.scm
View file @
0116bda6
...
...
@@ -233,6 +233,30 @@
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
all-entities-with-parent
db
table
type
parent
)
(
let
((
s
(
db-select
db
(
string-append
"select e.entity_id from "
table
"_entity as e "
"join "
table
"_value_varchar "
" as n on n.entity_id = e.entity_id and n.attribute_id = ?"
"join "
table
"_value_varchar "
" as p on p.entity_id = e.entity_id and p.attribute_id = ?"
"left join "
table
"_value_int "
"as d on d.entity_id = e.entity_id and d.attribute_id = ? "
"where e.entity_type = ? and "
"p.value = ? and "
"(d.value='NULL' or d.value is NULL or d.value = 0) "
"order by n.value"
)
"name"
"parent"
"deleted"
type
parent
)))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
(
map
(
lambda
(
i
)
(
vector-ref
i
0
))
(
cdr
s
)))))
(
define
(
validate
db
)
;; check attribute for duplicate entity-id/attribute-ids
0
)
...
...
@@ -262,13 +286,17 @@
(
else
(
cons
(
car
ktv-list
)
(
ktv-set
(
cdr
ktv-list
)
ktv
)))))
(
define
(
db-all
db
table
type
)
(
prof-start
"db-all"
)
(
let
((
r
(
map
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities
db
table
type
)))
(
define
(
db-with-parent
db
table
type
parent
)
(
map
(
lambda
(
i
)
(
get-entity
db
table
i
))
(
all-entities
db
table
type
))))
(
prof-end
"db-all"
)
r
))
(
all-entities-with-parent
db
table
type
parent
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data
...
...
android/assets/starwisp.scm
View file @
0116bda6
...
...
@@ -114,6 +114,8 @@
(
list
'market
(
list
"Market"
))
;; household
(
list
'household-name
(
list
"Household name"
))
(
list
'default-household-name
(
list
"A household"
))
(
list
'location
(
list
"House location"
))
(
list
'elevation
(
list
"Elevation"
))
(
list
'toilet-location
(
list
"Toilet location"
))
...
...
@@ -125,6 +127,9 @@
(
list
'add-individual
(
list
"Add individual"
))
;; individual
(
list
'default-individual-name
(
list
"A person"
))
(
list
'default-family-name
(
list
"A family"
))
(
list
'default-photo-id
(
list
"???"
))
(
list
'details
(
list
"Details"
))
(
list
'family
(
list
"Family"
))
(
list
'migration
(
list
"Migration"
))
...
...
@@ -350,7 +355,7 @@
;; dispatches based on widget type
(
define
(
mupdate
widget-type
id-symbol
key
)
(
cond
((
eq?
widget-type
'edit-text
)
(
(
or
(
eq?
widget-type
'edit-text
)
(
eq?
widget-type
'text-view
))
(
update-widget
widget-type
(
get-symbol-id
id-symbol
)
'text
(
entity-get-value
key
)))
((
eq?
widget-type
'toggle-button
)
...
...
@@ -542,7 +547,7 @@
;; a standard builder for list widgets of entities and a
;; make new button, to add defaults to the list
(
define
(
build-list-widget
db
table
title
entity-type
edit-activity
ktv-default
)
(
define
(
build-list-widget
db
table
title
entity-type
edit-activity
parent
ktv-default
)
(
vert-colour
colour-two
(
horiz
...
...
@@ -552,7 +557,7 @@
(
lambda
()
(
entity-init!
db
table
entity-type
ktv-default
)
(
entity-record-values!
)
(
list
(
update-list-widget
db
table
entity-type
edit-activity
)))))
(
list
(
update-list-widget
db
table
entity-type
edit-activity
parent
)))))
(
linear-layout
(
make-id
(
string-append
entity-type
"-list"
))
'vertical
...
...
@@ -561,8 +566,11 @@
(
list
))))
;; pull db data into list of button widgets
(
define
(
update-list-widget
db
table
entity-type
edit-activity
)
(
let
((
search-results
(
db-all
db
table
entity-type
)))
(
define
(
update-list-widget
db
table
entity-type
edit-activity
parent
)
(
let
((
search-results
(
if
parent
(
db-with-parent
db
table
entity-type
parent
)
(
db-all
db
table
entity-type
))))
(
update-widget
'linear-layout
(
get-id
(
string-append
entity-type
"-list"
))
...
...
@@ -629,7 +637,7 @@
'
()))
))))
(
build-list-widget
db
"sync"
'villages
"village"
"village"
db
"sync"
'villages
"village"
"village"
#f
(
list
(
ktv
"name"
"varchar"
(
mtext-lookup
'default-village-name
))
(
ktv
"block"
"varchar"
""
)
...
...
@@ -641,7 +649,7 @@
(
set-current!
'activity-title
"Main screen"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
(
list
(
update-list-widget
db
"sync"
"village"
"village"
)))
(
list
(
update-list-widget
db
"sync"
"village"
"village"
#f
)))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
...
...
@@ -711,8 +719,7 @@
(
mupdate
'edit-text
'block
"block"
)
(
mupdate
'edit-text
'district
"district"
)
(
mupdate
'toggle-button
'car
"car"
)
(
mupdate
'image-view
'photo
"photo"
)
(
toast
arg
)))
(
mupdate
'image-view
'photo
"photo"
)))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
...
...
@@ -736,7 +743,7 @@
"household-list"
(
build-activity
(
build-list-widget
db
"sync"
'households
"household"
"household"
db
"sync"
'households
"household"
"household"
(
get-current
'village
#f
)
(
list
(
ktv
"name"
"varchar"
(
mtext-lookup
'default-household-name
))
(
ktv
"num-pots"
"int"
0
)
...
...
@@ -749,7 +756,8 @@
(
set-current!
'activity-title
"Household List"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
(
list
(
update-list-widget
db
"sync"
"household"
"household"
)))
(
list
(
update-list-widget
db
"sync"
"household"
"household"
arg
)))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
...
...
@@ -778,9 +786,9 @@
(
medit-text
'elevation
"numeric"
(
lambda
(
v
)
'
())))
(
build-list-widget
db
"sync"
'individuals
"individual"
"individual"
db
"sync"
'individuals
"individual"
"individual"
(
get-current
'household
#f
)
(
list
(
ktv
"name"
"varchar"
(
mtext-lookup
'default-
household
-name
))
(
ktv
"name"
"varchar"
(
mtext-lookup
'default-
individual
-name
))
(
ktv
"family"
"varchar"
(
mtext-lookup
'default-family-name
))
(
ktv
"photo-id"
"varchar"
(
mtext-lookup
'default-photo-id
))
(
ktv
"parent"
"varchar"
(
get-current
'household
"error no household set"
)))))
...
...
@@ -791,7 +799,7 @@
(
entity-init!
db
"sync"
"household"
(
get-entity-by-unique
db
"sync"
arg
))
(
set-current!
'household
arg
)
(
list
(
update-list-widget
db
"sync"
"
household"
"household"
)
(
update-list-widget
db
"sync"
"
individual"
"individual"
arg
)
(
mupdate
'edit-text
'household-name
"name"
)
(
mupdate
'edit-text
'num-pots
"num-pots"
)))
...
...
@@ -810,6 +818,7 @@
(
mtext
'name
)
(
mtext
'family
)
(
mtext
'photo-id
)))
(
mbutton
'agreement
(
lambda
()
(
list
(
start-activity
"agreement"
0
""
))))
(
horiz
(
mbutton-scale
'details
(
lambda
()
(
list
(
start-activity
"details"
0
""
))))
(
mbutton-scale
'family
(
lambda
()
(
list
(
start-activity
"family"
0
""
)))))
...
...
@@ -818,13 +827,18 @@
(
mbutton-scale
'income
(
lambda
()
(
list
(
start-activity
"income"
0
""
)))))
(
horiz
(
mbutton-scale
'geneaology
(
lambda
()
(
list
(
start-activity
"geneaology"
0
""
))))
(
mbutton-scale
'social
(
lambda
()
(
list
(
start-activity
"social"
0
""
)))))
(
mbutton
'agreement
(
lambda
()
(
list
(
start-activity
"agreement"
0
""
)))))
(
mbutton-scale
'social
(
lambda
()
(
list
(
start-activity
"social"
0
""
))))))
(
lambda
(
activity
arg
)
(
set-current!
'activity-title
"Individual"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
'
())
(
lambda
(
activity
arg
)
(
entity-init!
db
"sync"
"individual"
(
get-entity-by-unique
db
"sync"
arg
))
(
set-current!
'individual
arg
)
(
list
(
mupdate
'text-view
'name
"name"
)
(
mupdate
'text-view
'family
"family"
)
(
mupdate
'text-view
'photo-id
"photo-id"
)))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment