fixed dynamic id again, more i18n

android/assets/dbsync.scm

@@ -112,6 +112,7 @@
     (entity-add-value! "time" "varchar" (date-time->string (date-time)))
     (entity-add-value! "lat" "real" (car (get-current 'location '(0 0))))
     (entity-add-value! "lon" "real" (cadr (get-current 'location '(0 0))))
+    (entity-add-value! "deleted" "int" 0)
     (let ((values (get-current 'entity-values '())))
       (cond
        ((not (null? values))

android/assets/eavdb.scm

@@ -218,124 +218,13 @@
   (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 "
-                              "where entity_type = ? and n.attribute_id = ? order by n.value")
-            type "name")))
-    (msg (db-status db))
-    (if (null? s)
-        '()
-        (map
-         (lambda (i)
-           (vector-ref i 0))
-         (cdr s)))))
-
-(define (all-entities-where db table type ktv)
-  (let ((s (db-select
-            db (string-append
-                "select e.entity_id from " table "_entity as e "
-                "join " table "_value_" (ktv-type ktv)
-                " as a on a.entity_id = e.entity_id "
-                "join " table "_value_varchar "
-                " as n on n.entity_id = e.entity_id "
-                "where e.entity_type = ? and a.attribute_id = ? "
-                "and a.value = ? and n.attribute_id = ? order by n.value")
-            type (ktv-key ktv) (ktv-value ktv) "name")))
-    (msg (db-status db))
-    (if (null? s)
-        '()
-        (map
-         (lambda (i)
-           (vector-ref i 0))
-         (cdr s)))))
-
-(define (all-entities-where2 db table type ktv ktv2)
-  (let ((s (db-select
-            db (string-append
-                "select e.entity_id from " table "_entity as e "
-                "join " table "_value_" (ktv-type ktv)
-                " as a on a.entity_id = e.entity_id "
-                "join " table "_value_" (ktv-type ktv2)
-                " as b on b.entity_id = e.entity_id "
-                "where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and b.value = ? ")
-            type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2))))
-    (msg (db-status db))
-    (if (null? s)
-        '()
-        (map
-         (lambda (i)
-           (vector-ref i 0))
-         (cdr s)))))
-
-(define (all-entities-where2or db table type ktv ktv2 or-value)
-  (let ((s (db-select
-            db (string-append
-                "select e.entity_id from " table "_entity as e "
-                "join " table "_value_" (ktv-type ktv)
-                " as a on a.entity_id = e.entity_id "
-                "join " table "_value_" (ktv-type ktv2)
-                " as b on b.entity_id = e.entity_id "
-                "where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and (b.value = ? or b.value = ?) ")
-            type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2) or-value)))
-    (msg (db-status db))
-    (if (null? s)
-        '()
-        (map
-         (lambda (i)
-           (vector-ref i 0))
-         (cdr s)))))
-
-(define (all-entities-where-newer db table type ktv ktv2)
-  (let ((s (db-select
-            db (string-append
-                "select e.entity_id from " table "_entity as e "
-                "join " table "_value_" (ktv-type ktv)
-                " as a on a.entity_id = e.entity_id "
-                "join " table "_value_" (ktv-type ktv2)
-                " as b on b.entity_id = e.entity_id "
-                "where e.entity_type = ? "
-                "and a.attribute_id = ? and a.value = ? "
-                "and b.attribute_id = ? and (b.value > DateTime(?) and b.value != ?)"
-                )
-            type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown")))
-    (msg "date select" (db-status db))
-    (if (null? s)
-        '()
-        (map
-         (lambda (i)
-           (vector-ref i 0))
-         (cdr s)))))
-
-(define (all-entities-where-older db table type ktv ktv2)
-  (let ((s (db-select
-            db (string-append
-                "select e.entity_id from " table "_entity as e "
-                "join " table "_value_" (ktv-type ktv)
-                " as a on a.entity_id = e.entity_id "
-                "join " table "_value_" (ktv-type ktv2)
-                " as b on b.entity_id = e.entity_id "
-                "where e.entity_type = ? "
-                "and a.attribute_id = ? and a.value = ? "
-                "and b.attribute_id = ? and (b.value < DateTime(?) or b.value = ?)"
-                )
-            type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown")))
-    (msg "date select" (db-status db))
-    (if (null? s)
-        '()
-        (map
-         (lambda (i)
-           (vector-ref i 0))
-         (cdr s)))))
-
-(define (update-entities-where2 db table type ktv ktv2)
-  (let ((s (db-select
-            db (string-append
-                "select e.entity_id from " table "_entity as e "
-                "join " table "_value_" (ktv-type ktv)
-                " as a on a.entity_id = e.entity_id "
-                "join " table "_value_" (ktv-type ktv2)
-                " as b on b.entity_id = e.entity_id "
-                "where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and b.value = ? ")
-            type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2))))
+                              " as n on n.entity_id = e.entity_id and n.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 (d.value='NULL' or d.value is NULL or d.value = 0) "
+                              "order by n.value")
+            "name" "deleted" type)))
     (msg (db-status db))
     (if (null? s)
         '()
@@ -372,7 +261,6 @@
     (cons ktv (cdr ktv-list)))
    (else (cons (car ktv-list) (ktv-set (cdr ktv-list) ktv)))))
 
-
 (define (db-all db table type)
   (prof-start "db-all")
   (let ((r (map
@@ -382,63 +270,6 @@
     (prof-end "db-all")
     r))
 
-;(define (db-all-where db table type clause)
-;  (prof-start "db-all-where")
-;  (let ((r (foldl
-;            (lambda (i r)
-;              (let ((e (get-entity db table i)))
-;                (if (equal? (ktv-get e (car clause)) (cadr clause))
-;                    (cons e r) r)))
-;            '()
-;            (all-entities db table type))))
-;    (prof-end "db-all-where")
-;    r))
-
-(define (db-all-where db table type ktv)
-  (prof-start "db-all-where")
-  (let ((r (map
-            (lambda (i)
-              (get-entity db table i))
-            (all-entities-where db table type ktv))))
-    (prof-end "db-all-where")
-    r))
-
-(define (db-all-where2 db table type ktv ktv2)
-  (prof-start "db-all-where2")
-  (let ((r (map
-            (lambda (i)
-              (get-entity db table i))
-            (all-entities-where2 db table type ktv ktv2))))
-    (prof-end "db-all-where2")
-    r))
-
-(define (db-all-where2or db table type ktv ktv2 or-value)
-  (prof-start "db-all-where2or")
-  (let ((r (map
-            (lambda (i)
-              (get-entity db table i))
-            (all-entities-where2or db table type ktv ktv2 or-value))))
-    (prof-end "db-all-where2or")
-    r))
-
-(define (db-all-newer db table type ktv ktv2)
-  (prof-start "db-all-where newer")
-  (let ((r (map
-            (lambda (i)
-              (get-entity db table i))
-            (all-entities-where-newer db table type ktv ktv2))))
-    (prof-end "db-all-where newer")
-    r))
-
-(define (db-all-older db table type ktv ktv2)
-  (prof-start "db-all-where older")
-  (let ((r (map
-            (lambda (i)
-              (get-entity db table i))
-            (all-entities-where-older db table type ktv ktv2))))
-    (prof-end "db-all-where older")
-    r))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; updating data
 

android/assets/lib.scm

@@ -547,15 +547,21 @@
   (id-map-get name))
 
 (define (make-id name)
+  (msg "making id for" name)
   (let ((id (id-map-get name)))
     (cond
      ((zero? id)
+      (msg "this is a new id")
      ; (prof-start "make-id")
       (id-map-add name current-id)
       (set! current-id (+ current-id 1))
      ; (prof-end "make-id")
       (- current-id 1))
-     (else id))))
+     (else
+      ;; seems scheme is shut down while the id store keeps going?
+      (when (> id current-id) (set! current-id (+ id 1)))
+      (msg "we have seen this one before")
+      id))))
 
 (define prof-map '())
 
@@ -744,6 +750,7 @@
          ((null? w) #f)
          ;; drill deeper
          ((eq? (update-widget-token w) 'contents)
+          (msg "updateing contents from callback")
           (update-callbacks! (update-widget-value w)))
          ((eq? (update-widget-token w) 'grid-buttons)
           (add-callback! (callback (update-widget-id w)
@@ -880,7 +887,10 @@
                  ((callback-fn cb)))
                 (else
                  (msg "no callbacks for type" (callback-type cb))))))
-          ;;(update-callbacks! events)
+          ;; this was just update-callbacks, commented out,
+          ;; expecting trouble here... (but seems to fix new widgets from
+          ;; widget callbacks so far)
+          (update-callbacks-from-update! events)
           (update-dialogs! events)
           (send (scheme->json events))
           (prof-end "widget-callback")))))

android/assets/starwisp.scm

@@ -72,6 +72,10 @@
    (list 'ok (list "Ok" "Ok" "Ok"))
    (list 'cancel (list "Cancel" "Cancel" "Cancel"))
    (list 'villages (list "Villages" "Villages" "Villages"))
+   (list 'list-empty (list "List empty"))
+   (list 'delete (list "Delete"))
+   (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?"))
 
    ;; village screen
    (list 'village-name (list "Village name" "Village name" "Village name"))
@@ -262,12 +266,12 @@
 (define (mtitle id)
   (text-view (symbol->id id)
              (mtext-lookup id)
-             50 (layout 'fill-parent 'wrap-content -1 'centre 0)))
+             50 (layout 'fill-parent 'wrap-content -1 'centre 5)))
 
 (define (mtitle-scale id)
   (text-view (symbol->id id)
              (mtext-lookup id)
-             50 (layout 'fill-parent 'wrap-content 1 'centre 0)))
+             50 (layout 'fill-parent 'wrap-content 1 'centre 5)))
 
 (define (medit-text id type fn)
   (vert
@@ -340,25 +344,6 @@
    (else (msg "mupdate-widget unhandled widget type" widget-type))))
 
 ;;;;
-
-(define (db-mongooses-by-pack)
-  (db-all-where
-   db "sync" "mongoose"
-   (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))))
-
-(define (db-mongooses-by-pack-male)
-  (db-all-where2or
-   db "sync" "mongoose"
-   (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
-   (ktv "gender" "varchar" "Male") "Unknown"))
-
-(define (db-mongooses-by-pack-female)
-  (db-all-where2or
-   db "sync" "mongoose"
-   (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
-   (ktv "gender" "varchar" "Female") "Unknown"))
-
-
 ;; (y m d h m s)
 (define (date-minus-months d ms)
   (let ((year (list-ref d 0))
@@ -372,18 +357,6 @@
        (list-ref d 4)
        (list-ref d 5)))))
 
-(define (db-mongooses-by-pack-pups)
-  (db-all-newer
-   db "sync" "mongoose"
-   (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
-   (ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6)))))
-
-(define (db-mongooses-by-pack-adults)
-  (db-all-older
-   db "sync" "mongoose"
-   (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
-   (ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6)))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 
@@ -479,7 +452,6 @@
    (lambda (fragment arg)
      (activity-layout fragment))
    (lambda (fragment arg)
-     (msg "updating top" (get-current 'activity-title "Title not set"))
      (list
       (update-widget 'text-view (get-id "title") 'text
                      (get-current 'activity-title "Title not set"))))
@@ -502,7 +474,7 @@
         (list
          (alert-dialog
           "ok-check"
-          "Are you sure you want to save changes?"
+          (mtext-lookup 'save-are-you-sure)
           (lambda (v)
             (cond
              ((eqv? v 1)
@@ -567,20 +539,40 @@
 
 ;; pull db data into list of button widgets
 (define (update-list-widget db table entity-type edit-activity)
-  (update-widget
-   'linear-layout
-   (get-id (string-append entity-type "-list"))
-   'contents
-   (map
-    (lambda (e)
-      (button
-       (make-id (string-append "list-button-" (ktv-get e "unique_id")))
-       (or (ktv-get e "name") "Unamed item")
-       40 (layout 'fill-parent 'wrap-content 1 'centre 5)
-       (lambda ()
-         (msg "sending start act" (ktv-get e "unique_id"))
-         (list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
-    (db-all db table entity-type))))
+  (let ((search-results (db-all db table entity-type)))
+    (update-widget
+     'linear-layout
+     (get-id (string-append entity-type "-list"))
+     'contents
+     (if (null? search-results)
+         (list (mtext 'list-empty))
+         (map
+          (lambda (e)
+            (button
+             (make-id (string-append "list-button-" (ktv-get e "unique_id")))
+             (or (ktv-get e "name") "Unamed item")
+             40 (layout 'fill-parent 'wrap-content 1 'centre 5)
+             (lambda ()
+               (msg "sending start act" (ktv-get e "unique_id"))
+               (list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
+          search-results)))))
+
+(define (delete-button)
+  (mbutton
+   'delete
+   (lambda ()
+     (list
+      (alert-dialog
+       "delete-check"
+       (mtext-lookup 'delete-are-you-sure)
+       (lambda (v)
+         (cond
+          ((eqv? v 1)
+           (entity-set-value! "deleted" "int" 1)
+           (entity-update-values!)
+           (list (finish-activity 1)))
+          (else
+           (list)))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; activities
@@ -598,12 +590,13 @@
      (mbutton-scale 'sync (lambda () (list))))
 
     (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
-    (build-list-widget db "sync" "village" "village"
-                       (list
-                        (ktv "name" "varchar" (mtext-lookup 'default-village-name))
-                        (ktv "block" "varchar" "")
-                        (ktv "district" "varchar" "test")
-                        (ktv "car" "int" 0))))
+    (build-list-widget
+     db "sync" "village" "village"
+     (list
+      (ktv "name" "varchar" (mtext-lookup 'default-village-name))
+      (ktv "block" "varchar" "")
+      (ktv "district" "varchar" "test")
+      (ktv "car" "int" 0))))
 
    (lambda (activity arg)
      (set-current! 'activity-title "Main screen")
@@ -655,7 +648,8 @@
       (place-widgets 'district-bus-service #f)
       (place-widgets 'panchayat #t)
       (place-widgets 'NGO #f)
-      (place-widgets 'market #t)))
+      (place-widgets 'market #t)
+      (delete-button)))
    (lambda (activity arg)
      (set-current! 'activity-title "Village")
      (activity-layout activity))