produce-recent-tree-atom was using parent path

--- src/com/billpiel/sayid/inner_trace3.clj
+++ src/com/billpiel/sayid/inner_trace3.clj
@@ -232,7 +232,7 @@

 (defn produce-recent-tree-atom!
   [path path-parents tree-atom & {:keys [skip-closed-check]}]
-  (if-let [tree-atom (get-recent-tree-at-inner-path (path-parents path)
+  (if-let [tree-atom (get-recent-tree-at-inner-path path
                                                     tree-atom
                                                     :skip-closed-check skip-closed-check)]
     tree-atom


Somewhat working side walls

Somewhat working side walls

--- src/dactyl_keyboard/dactyl-manuform.clj
+++ src/dactyl_keyboard/dactyl-manuform.clj
@@ -6,6 +6,7 @@

 (def nrows 4)
+(def ncols 6)
 (def lastrow (dec nrows))
 (def cornerrow (dec lastrow))

@@ -91,7 +92,7 @@
 ;; Placement Functions ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;

-(def columns (range 0 6))
+(def columns (range 0 ncols))
 (def rows (range 0 nrows))

 (def α (/ π 12))
@@ -139,6 +140,27 @@
          (rotate (/ π 12) [0 1 0])
          (translate [0 0 13]))))

+(defn bottom-place [column row shape]
+  (let [row-placed-shape (->> shape
+                              (translate [0 0 (- row-radius)])
+                              (rotate (* α (- 2 row)) [1 0 0])
+                              (translate [0 0 row-radius]))
+        column-offset (cond (< column 1.5) [-1 0 0]
+                       :else [0 0 0])
+        column-row-offset (if (not= column 6) [0 -4.35 4.8]
+                        (if (not= row 4) [-7.25 -5.8 2.1]
+                                         [-7.89 -5.8 3.6]))
+        column-angle (* β (- 2 column))
+        placed-shape (->> row-placed-shape
+                          (translate [0 0 (- column-radius)])
+                          (rotate column-angle [0 1 0])
+                          (translate [0 0 column-radius])
+                          (translate column-row-offset)
+                          (translate column-offset))]
+    (->> placed-shape
+         (rotate (/ π 12) [0 1 0])
+         (translate [0 0 13]))))
+
 (def key-holes
   (apply union
          (for [column columns
@@ -182,7 +204,7 @@
   (apply union
          (concat
           ;; Row connections
-          (for [column (drop-last columns)
+          (for [column (range -1 ncols)
                 row rows
                 :when (or (.contains [2] column)
                           (not= row lastrow))]
@@ -194,7 +216,7 @@

           ;; Column connections
           (for [column columns
-                row (drop-last rows)
+                row (range -1 lastrow)
             ;     :when (or (.contains [2 3] column)
             ;               (not= row 2))
                           ]
@@ -205,8 +227,8 @@
              (key-place column (inc row) web-post-tr)))

           ;; Diagonal connections
-          (for [column (drop-last columns)
-                row (drop-last rows)
+          (for [column (range -1 ncols)
+                row (range -1 lastrow)
             ;     :when (or (.contains [ 1 2 3] column)
             ;               (not= row 2))
                           ]
@@ -359,28 +381,260 @@
       )
   ))

-(spit "repl.scad"
-      (write-scad (union
-                   key-holes
-                   connectors
-                   thumb
-                   thumb-connectors
-                  ;  thumbcaps
-                   caps
-                  ;  front-wall
-                  ;  right-wall
-                  ;  new-case
-                   )))
-
 ;;;;;;;;;;
 ;; Case ;;
 ;;;;;;;;;;

 ;; In column units
-(def right-wall-column (+ (last columns) 0.55))
+(def right-wall-column (+ (last columns) 0.1))
 (def left-wall-column (- (first columns) 1/2))
-(def thumb-back-y 0.93)
+(def thumb-back-y 0.1)
+(def thumb-case-z 3)
 (def thumb-right-wall (- -1/2 0.05))
 (def thumb-front-row (+ -1 0.07))
 (def thumb-left-wall-column (+ 5/2 0.05))
 (def back-y 0.02)
+
+(defn range-inclusive [start end step]
+  (concat (range start end step) [end]))
+
+(def wall-step 0.2)
+(def wall-sphere-n 20) ;;20 Sphere resolution, lower for faster renders
+
+(defn wall-cube-at [coords]
+  (->> (cube 3 3 3)
+       (translate coords)))
+
+(defn scale-to-range [start end x]
+  (+ start (* (- end start) x)))
+
+(defn wall-cube-bottom [front-to-back-scale]
+  (wall-cube-at [0
+                   (scale-to-range
+                    (+ (/ mount-height -2) -3.5)
+                    (+ (/ mount-height 2) 5.0)
+                    front-to-back-scale)
+                   -6])) ; was -6, then 2
+
+(defn wall-cube-top [front-to-back-scale]
+  (wall-cube-at [0
+                   (scale-to-range
+                    (+ (/ mount-height -2) -3.5)
+                    (+ (/ mount-height 2) 3.5)
+                    front-to-back-scale)
+                   4])) ; case height
+
+(def wall-cube-top-back (wall-cube-top 1))
+(def wall-cube-bottom-back (wall-cube-bottom 1))
+(def wall-cube-bottom-front (wall-cube-bottom 0))
+(def wall-cube-top-front (wall-cube-top 0))
+
+
+(defn bottom [height p]
+  (->> (project p)
+       (extrude-linear {:height height :twist 0 :convexity 0})
+       (translate [0 0 (/ height 2)])))
+
+(defn bottom-hull [& p]
+  (hull p (bottom 10.001 p)))
+
+
+(def bottom-key-guard (->> (cube mount-width mount-height web-thickness)
+                           (translate [0 0 (+ (- (/ web-thickness 2)) -5)])))
+(def bottom-front-key-guard (->> (cube mount-width (/ mount-height 2) web-thickness)
+                                 (translate [0 (/ mount-height 4) (+ (- (/ web-thickness 2)) -5)])))
+
+(defn stand-at [diameter placement]
+  (let [bumper-radius (/ diameter 2)
+       stand-diameter (+ diameter 2)
+       stand-radius (/ stand-diameter 2)]
+    (difference (->> (sphere stand-radius)
+                     (translate [0 0 (+ (/ stand-radius -2) -4.5)])
+                      placement
+                      bottom-hull)
+                (->> (cube stand-diameter stand-diameter stand-radius)
+                     (translate [0 0 (/ stand-radius -2)])
+                      placement)
+                (->> (sphere bumper-radius)
+                     (translate [0 0 (+ (/ stand-radius -2) -4.5)])
+                      placement
+                     (bottom 1.5)))))
+
+(def outer-case
+  (union
+  ;  (let [shift #(translate [0 0 (+ (+ web-thickness) 0)] %)
+   (let [shift #(scale [1 1 1] %)
+         thumb-ridge-height 1
+         thumb-back-offset -1.28
+         thumb-left-offset 1.13
+         thumb-front-offset 0.56
+         front-offset 0.3
+         left-offset 0.2
+         right-offset -0.23
+         back-offset -0.25
+         web-post-tl border-post-tl
+         web-post-tr border-post-tr
+         web-post-br border-post-br
+         web-post-bl border-post-bl
+         half-shift-correction #(translate [0 (/ mount-height 2) 0] %)
+         half-post-br (half-shift-correction web-post-br)
+         half-post-bl (half-shift-correction web-post-bl)
+         row-connections (concat
+                          (for [column (drop-last columns)
+                                row (drop-last rows)
+                                :when (or (not= column 0)
+                                          (not= row 4))]
+                            (triangle-hulls
+                             (key-place (inc column) row web-post-tl)
+                             (key-place column row web-post-tr)
+                             (key-place (inc column) row web-post-bl)
+                             (key-place column row web-post-br)))
+                          (for [column (drop-last columns)
+                                row [(last rows)]
+                                :when (or (not= column 0)
+                                          (not= row 4))]
+                            (triangle-hulls
+                             (key-place (inc column) row web-post-tl)
+                             (key-place column row web-post-tr)
+                             (key-place (inc column) row half-post-bl)
+                             (key-place column row half-post-br))))
+         column-connections (for [column columns
+                                  row (drop-last rows)
+                                  :when (or (not= column 0)
+                                            (not= row 3))]
+                              (triangle-hulls
+                               (key-place column row web-post-bl)
+                               (key-place column row web-post-br)
+                               (key-place column (inc row) web-post-tl)
+                               (key-place column (inc row) web-post-tr)))
+         diagonal-connections (for [column (drop-last columns)
+                                    row (drop-last rows)
+                                    :when (or (not= column 0)
+                                              (not= row 3))]
+                                (triangle-hulls
+                                 (key-place column row web-post-br)
+                                 (key-place column (inc row) web-post-tr)
+                                 (key-place (inc column) row web-post-bl)
+                                 (key-place (inc column) (inc row) web-post-tl)))
+         main-keys-bottom (concat row-connections
+                                  column-connections
+                                  diagonal-connections)
+         front-wall (concat
+                     (for [x (range 4 6)]
+                      (union
+                       (bottom-hull
+                             (key-place (+ x 1) 2.2 web-post-bl)
+                             (key-place x 2.2 web-post-br))
+                       (bottom-hull
+                             (key-place x 2.2 web-post-bl)
+                             (key-place x 2.2 web-post-br)
+                        ))))
+         right-wall (concat
+                     (for [x (range 1 3)]
+                      (union
+                       (bottom-hull
+                             (key-place 5.2 x web-post-br)
+                             (key-place 5.2 x web-post-tr))
+                       (bottom-hull
+                             (key-place 5.2 x web-post-br)
+                             (key-place 5.2 (dec x) web-post-tr))
+                     )))
+         back-wall (concat
+                    (for [x (range  6)]
+                      (union
+                       (hull
+                             (key-place x -0.2 web-post-tl)
+                             (key-place x -0.2 web-post-tr))
+                       (hull
+                             (key-place x -0.2 web-post-tl)
+                             (key-place (- x 1) -0.2 web-post-tr))
+                      ))
+                    )
+         left-wall (concat
+                     (for [x (range 1 3)]
+                      (union
+                       (bottom-hull
+                             (key-place -1.0 x web-post-br)
+                             (key-place -1.0 x web-post-tr))
+                       (bottom-hull
+                             (key-place -1.0 x web-post-br)
+                             (key-place -1.0 (dec x) web-post-tr))
+                     )))
+         ]
+     (apply union
+            (concat
+             ;main-keys-bottom
+             front-wall
+             right-wall
+             back-wall
+             left-wall
+             ;thumbs
+            ;  thumb-back-wall
+            ;  thumb-left-wall
+            ;  thumb-front-wall
+            ;  thumb-inside
+             ;stands)))))
+             )))))
+
+(def border-web-post (cube post-size post-size web-thickness))
+(def border-post-adj (/ border-post-size 2))
+(def border-post-tr (translate [(- (/ mount-width 2) border-post-adj) (- (/ mount-height 2) border-post-adj) 0] border-web-post))
+(def border-post-tl (translate [(+ (/ mount-width -2) border-post-adj) (- (/ mount-height 2) border-post-adj) 0] border-web-post))
+(def border-post-bl (translate [(+ (/ mount-width -2) border-post-adj) (+ (/ mount-height -2) border-post-adj) 0] border-web-post))
+(def border-post-br (translate [(- (/ mount-width 2) border-post-adj) (+ (/ mount-height -2) border-post-adj) 0] border-web-post))
+
+(def upper-brace-multiplier -4)
+(defn wall-brace [x1 y1 dx1 dy1 post1 x2 y2 dx2 dy2 post2]
+  (union
+    (hull
+      (key-place x1 y1 post1)
+      (key-place x1 y1 (scale [1 1 -3] post1))
+      (key-place x1 y1 (translate [(* dx1 5) (* dy1 5) 0] (scale [1 1 -3] post1)))
+      (key-place x2 y2 post2)
+      (key-place x2 y2 (scale [1 1 -3] post2))
+      (key-place x2 y2 (translate [(* dx2 5) (* dy2 5) 0] (scale [1 1 -3] post2)))
+      )
+    (bottom-hull
+      (key-place x1 y1 (translate [(* dx1 5) (* dy1 5) -15] post1))
+      (key-place x1 y1 (translate [0         0         -15] post1))
+      (key-place x1 y1 (translate [(* dx1 5) (* dy1 5) -15] post1))
+      (key-place x2 y2 (translate [0         0         -15] post2))
+      (key-place x2 y2 (translate [(* dx2 5) (* dy2 5) -15] post2))
+      )
+    ; (hull
+    ;   (translate [0 0 -199] (key-place x1 y1 (translate [0         0         -15] post1)))
+    ;   (translate [0 0 -199] (key-place x2 y2 (translate [0         0         -15] post2)))
+    ;   (key-place x1 y1 (translate [(* dx1 5) (* dy1 5) -15] post1))
+    ;   (key-place x1 y1 (translate [0         0         -15] post1))
+    ;   (key-place x1 y1 (translate [(* dx1 5) (* dy1 5) -15] post1))
+    ;   (key-place x2 y2 (translate [0         0         -15] post2))
+    ;   (key-place x2 y2 (translate [(* dx1 5) (* dy1 5) -15] post2))
+    ;   )
+    ))
+
+(def case-walls
+  (union
+   ; back wall
+   (for [x (range 0 6)] (wall-brace x 0 0 1 web-post-tl x       0 0 1 web-post-tr))
+   (for [x (range 1 6)] (wall-brace x 0 0 1 web-post-tl (dec x) 0 0 1 web-post-tr))
+   ; right wall
+   (for [y (range 0 3)] (wall-brace 5 y 1 0 web-post-tr 5 y       1 0 web-post-br))
+   (for [y (range 1 3)] (wall-brace 5 (dec y) 1 0 web-post-br 5 y 1 0 web-post-tr))
+   ; left wall
+   (for [y (range 0 3)] (wall-brace 0 y -1 0 web-post-tl 0 y       -1 0 web-post-bl))
+   (for [y (range 1 3)] (wall-brace 0 (dec y) -1 0 web-post-bl 0 y -1 0 web-post-tl))
+  ))
+
+(spit "repl.scad"
+      (write-scad (difference (union
+                   key-holes
+                  ;  connectors
+                   thumb
+                   thumb-connectors
+                  ;  thumbcaps
+                  ;  caps
+                  ;  front-wall
+                  ;  right-wall
+                   case-walls
+                   )
+                   (translate [0 0 -599] (cube 999 999 999)))))


Remove C-x shortcut to close thread (conflicts with cut for non-OSX)

--- src/braid/client/ui/views/thread.cljs
+++ src/braid/client/ui/views/thread.cljs
@@ -214,10 +214,7 @@

           :on-key-down
           (fn [e]
-            (when (or (and
-                        (= KeyCodes.X (.-keyCode e))
-                        (.-ctrlKey e))
-                      (= KeyCodes.ESC (.-keyCode e)))
+            (when (= KeyCodes.ESC (.-keyCode e))
               (helpers/stop-event! e)
               (dispatch [:hide-thread {:thread-id (thread :id)}])))


default canvas support in macros

default canvas support in macros

--- src/clj/infinitelives/pixi/macros.clj
+++ src/clj/infinitelives/pixi/macros.clj
@@ -15,7 +15,7 @@
     (throw (js/Error (str "canvas layer " ~layer " not found.")))
     ))

-(defmacro with-sprite [canvas layer bindings & body]
+(defmacro with-sprite* [canvas layer bindings & body]
   (assert-args
    (vector? bindings) "a vector for its binding"
    (even? (count bindings)) "an even number of forms in binding vector")
@@ -28,6 +28,26 @@
               (finally (.removeChild (get-layer ~canvas ~layer) ~symb)))))
     `(do ~@body)))

+(defmacro with-sprite [& body]
+  (cond
+    (vector? (first body))
+    `(with-sprite*
+       (infinitelives.pixi.canvas/get-default-canvas) (infinitelives.pixi.canvas/get-default-layer)
+       ~(first body)
+       ~@(next body))
+
+    (vector? (second body))
+    `(with-sprite*
+       (infinitelives.pixi.canvas/get-default-canvas) ~(first body)
+       ~(second body)
+       ~@(nnext body))
+
+    :default
+    `(with-sprite* ~@body)))
+
+(comment
+  (macroexpand-1 '(with-sprite [a (ms)] a b c)))
+
 (defmacro with-layered-sprite [bindings & body]
   (assert-args
    (vector? bindings) "a vector for its binding"
@@ -38,7 +58,7 @@
           layer (second bindings)
           val (nth bindings 2)]
       `(let [~symb ~val
-             canvas# (infinitelives.pixi.canvas/get)]
+             canvas# (infinitelives.pixi.canvas/get-default-canvas)]
          (try (.addChild
                (get-layer canvas# ~layer)
                ~symb)
@@ -48,7 +68,7 @@
                         ~symb)))))
     `(do ~@body)))

-(defmacro with-sprite-set [canvas layer bindings & body]
+(defmacro with-sprite-set* [canvas layer bindings & body]
   (assert-args
    (vector? bindings) "a vector for its binding"
    (even? (count bindings)) "an even number of forms in binding vector")
@@ -64,6 +84,24 @@
                       (.removeChild (get-layer ~canvas ~layer) sprite#))))))
     `(do ~@body)))

+(defmacro with-sprite-set [& body]
+  (cond
+    (vector? (first body))
+    `(with-sprite-set*
+       (infinitelives.pixi.canvas/get-default-canvas) (infinitelives.pixi.canvas/get-default-layer)
+       ~(first body)
+       ~@(next body))
+
+    (vector? (second body))
+    `(with-sprite-set*
+       (infinitelives.pixi.canvas/get-default-canvas) ~(first body)
+       ~(second body)
+       ~@(nnext body))
+
+    :default
+    `(with-sprite-set* ~@body)))
+
+
 (defmacro while-let
     "Repeatedly executes body while test expression is true, evaluating the body with binding-form bound to the value of test."
     [bindings & body]


Removed duplicate function

Removed duplicate function

--- src/cljs/salava/social/ui/stream.cljs
+++ src/cljs/salava/social/ui/stream.cljs
@@ -26,12 +26,6 @@
                        :initial false
                        :pending-badges (:pending-badges data)
                        :tips (:tips data)))}))
-
-(defn pending-connections [reload-fn]
-  (let [connections (first (plugin-fun (session/get :plugins) "block" "pendingconnections"))]
-    (if connections
-      [connections reload-fn]
-      [:div ""])))

 (defn pending-connections [reload-fn]
   (let [connections (first (plugin-fun (session/get :plugins) "block" "pendingconnections"))]


added newer path refinement technique

added newer path refinement technique

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -636,10 +636,10 @@
         {}
         xpath-nodes))))

-(defn refine-xpath
+(defn refine-xpath-accuracy
   "Xpath refined to maximize yield on
    a per-page basis"
-  [action body url-ds muscle fat]
+  [action body url muscle fat]
   (let [processed-body (html->xml-doc body)

         nodes-paths    (page-nodes-hrefs-text processed-body
@@ -649,19 +649,93 @@
                         (fn [[path an-info]]
                           (= action (path->xpath-no-position path)))
                         nodes-paths)
+
+        muscle-nodes   (filter
+                        (fn [[path an-info]]
+                          (some
+                           (fn [x] (= (:href an-info)
+                                     x))
+                           muscle))
+                        nodes-paths-x)
+
+        fat-nodes      (filter
+                        (fn [[path an-info]]
+                          (some
+                           (fn [x] (= (:href an-info)
+                                     x))
+                           fat))
+                        nodes-paths-x)

-        paths          (map
-                        first
-                        nodes-paths-x)
-
-        counts         (map
-                        (fn [a-path]
-                          (map #(nth % 2) a-path))
-                        paths)
-
-        histogram      (map (fn [x]
-                              (count (distinct x)))
-                            (apply map vector counts))
-        pos            [(.indexOf histogram size)]]
-
-    action))
+        paths-list     (map first nodes-paths-x)
+
+        histogram      (map
+                        #(-> % distinct count)
+                        (apply map vector paths-list))
+
+        positions      (filter
+                        (fn [x]
+                          (not=
+                           (nth histogram x)
+                           1))
+                        (range (count histogram)))
+
+        stuff (map #(nth histogram %) positions)
+
+        muscle-paths-list (map first muscle-nodes)
+
+        muscle-histogram (map
+                          #(-> % distinct count)
+                          (apply map vector muscle-paths-list))
+
+        muscle-positions (filter
+                          (fn [x]
+                            (not=
+                             (nth muscle-histogram x)
+                             1))
+                          (range (count muscle-histogram)))
+
+        fat-paths-list (map first fat-nodes)
+
+        fat-histogram (map
+                       #(-> % distinct count)
+                       (apply map vector fat-paths-list))
+
+        fat-positions (filter
+                       (fn [x]
+                         (not=
+                          (nth fat-histogram x)
+                          1))
+                       (range (count fat-histogram)))]
+
+    {:only (map
+            (fn [p]
+              [p (nth
+                  (map
+                   #(map
+                     last
+                     (distinct %))
+                   (apply map vector muscle-paths-list))
+                  p)])
+            (filter
+             (fn [p]
+               (not
+                (some (fn [mp]
+                        (= mp p))
+                      muscle-positions)))
+             positions))
+     :avoid (map
+             (fn [p]
+               [p (nth
+                   (map
+                    #(map
+                      last
+                      (distinct %))
+                    (apply map vector fat-paths-list))
+                   p)])
+             (filter
+              (fn [p]
+                (not
+                 (some (fn [mp]
+                         (= mp p))
+                       fat-positions)))
+              positions))}))


Reformatting main.

Reformatting main.

--- comment-breaker/src/comment_breaker/core.clj
+++ comment-breaker/src/comment_breaker/core.clj
@@ -48,6 +48,8 @@
   [& args]
   (let [cli-map (get-args args)]
     (try
-      (spit (:out-file cli-map) (process-file (slurp (:in-file cli-map))))
+	  (->> (slurp (:in-file cli-map))
+		   (process-file)
+		   (spit (:out-file cli-map)))
 	  (catch java.io.IOException e
 	    (prn (.toString e))))))


DM + CM #3 - Pull out api authorization middleware wrapper

--- src/d_cent/core.clj
+++ src/d_cent/core.clj
@@ -16,6 +16,16 @@
             [d-cent.utils :as utils]
             [d-cent.workflows.twitter :refer [twitter-workflow]]))

+;; Custom ring middleware
+
+(defn wrap-api-authorize [handler roles]
+  (fn [request]
+    (if (friend/authorized? roles friend/*identity*)
+      (handler request)
+      {:status 401})))
+
+;; Handlers
+
 (defn index [{:keys [t' locale]}]
   (let [username (get (friend/current-authentication) :username)]
   (rendered-response index-page {:translation t'
@@ -23,8 +33,6 @@
                                  :doc-title (t' :index/doc-title)
                                  :doc-description (t' :index/doc-description)
                                  :signed-in (when username true)})))
-
-

 (defn sign-in [{:keys [t' locale]}]
   (let [username (get (friend/current-authentication) :username)]
@@ -41,13 +49,10 @@
   (simple-response "blah"))

 (defn email-capture-post [request]
-  (if (friend/authorized? #{:signed-in} friend/*identity*)
-    {:status 200}
-    {:status 401}))
+  {:status 200})

 (defn new-objective-link [stored-objective]
   (str utils/host-url "/objectives/" (:_id stored-objective)))
-

 (defn objective-new-link-page [{:keys [t' locale]} stored-objective]
   (let [username (get (friend/current-authentication) :username)]
@@ -78,7 +83,6 @@
          :body "oops"}))
     {:status 401}))

-
 (defn objective-view [{:keys [t' locale] :as request}]
   (let [username (get (friend/current-authentication) :username)
         objective (storage/retrieve "d-cent-test" (-> request :route-params :id))]
@@ -93,9 +97,9 @@
                :sign-in sign-in
                :sign-out sign-out
                :email-capture-get  (friend/wrap-authorize email-capture-get #{:signed-in})
-               :email-capture-post email-capture-post
+               :email-capture-post (wrap-api-authorize email-capture-post #{:signed-in})
                :objective-create   (friend/wrap-authorize objective-create #{:signed-in})
-               :objective-create-post (-> objective-create-post wrap-keyword-params wrap-params)
+               :objective-create-post objective-create-post
                :objective-view objective-view })

 (def routes


Add more cards

Add more cards

--- src/devcards/discuss/devcards/core.cljs
+++ src/devcards/discuss/devcards/core.cljs
@@ -40,7 +40,7 @@
          "Testing the small search engine in `discuss.find`"
          (testing "fn statement, sending request and counting results"
            (find/statement "are")
-           (is (= 4 (count (find/prepare-search-results))))))
+           (is (= 4 (count (find/get-search-results))))))

 (deftest integration-test
          "Testing `discuss.integration`"


Add todo

Add todo

--- src/discuss/references/integration.cljs
+++ src/discuss/references/integration.cljs
@@ -30,7 +30,7 @@
       (tooltip/hide))))

 (let [clicks (listen (.getElementById js/document "discuss-text") "click")]
-  (go (while true
+  (go (while true                                           ;; TODO Set a reasonable timeout
         (<! clicks)
         (save-selected-text))))


document open issues with hiding parameters in parameterized pipeline

--- src/clj/lambdacd/presentation/pipeline_structure.clj
+++ src/clj/lambdacd/presentation/pipeline_structure.clj
@@ -50,6 +50,9 @@
   (and a b))

 (defn- parameter-values [fun params]
+  ;; not supported at the moment:
+  ;; * declare variable arguments as hidden
+  ;; * declare arguments as hidden in function with more than one argument list (first one is always taken)
   (let [visible-args     (visible-args-bitmap fun)
         displayable-args (map displayable-parameter? params)
         ; pad to make sure varargs don't cause problems


Adds slider page.

Adds slider page.

--- src/cljs/reagent_toolbox_docs/components/slider.cljs
+++ src/cljs/reagent_toolbox_docs/components/slider.cljs
@@ -16,8 +16,41 @@
       "have icons to the left and right of the bar that reflect the value intensity. The "
       "interactive nature of the slider makes it a great choice for settings that reflect "
       "intensity levels, such as volume, brightness, or color saturation."]
-
+
+     [ui/display-and-eval-code
+      "(defn slider-test
+         []
+         (let [sliders (reagent.ratom/atom {:slider2 5 :slider3 1 :slider4 3})]
+           (fn []
+             [:section
+[:p \"Value: \" (pr-str @sliders)]
+              [:p \"Normal slider\"]
+              [reagent-toolbox.core/slider {:value (@sliders :slider1)
+                                            :on-change #(swap! sliders assoc :slider1 %)}]
+              [:p \"With steps, initial value, and editable\"]
+              [reagent-toolbox.core/slider {:value (@sliders :slider2)
+                                            :min 0
+                                            :max 10
+                                            :editable true
+                                            :on-change #(swap! sliders assoc :slider2 %)}]
+              [:p \"Pinned and with snaps\"]
+              [reagent-toolbox.core/slider {:value (@sliders :slider3)
+                                            :editable true
+                                            :pinned true
+                                            :snaps true
+                                            :min 0
+                                            :max 10
+                                            :step 1
+                                            :on-change #(swap! sliders assoc :slider3 %)}]
+              [:p \"Disabled\"]
+              [reagent-toolbox.core/slider {:value (@sliders :slider4)
+                                            :disabled true
+                                            :on-change #(swap! sliders assoc :slider4 %)}]
+
+])))
+       [slider-test]"]
+
      ]))

-  (defmethod layout/pages :slider [_]
-    [view]))
+(defmethod layout/pages :slider [_]
+  [view])


fix typo that is breaking new test 'go upstairs'

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -784,7 +784,7 @@
                                      :subcat {:1 {:agr {:person :2nd}}}}}
                            {:synsem {:cat :verb
                                      :infl :present
-                                     :subcat {:1 {:agr {:number :sing
+                                     :subcat {:1 {:agr {:number :plur
                                                         :person :3rd}}}}}]))))))))

 ;; TODO: rewrite with recur or map or similar, rather than recursively.


Split app into a few basic components

Split app into a few basic components

--- src/flux_challenge_re_frame/core.cljs
+++ src/flux_challenge_re_frame/core.cljs
@@ -4,17 +4,45 @@

 (enable-console-print!)

-(println "Edits to this text should show up in your developer console.")
-
 ;; define your app data so that it doesn't get over-written on reload

-(defonce app-state (atom {:text "Hello world!"}))
+(defonce app-state (atom {:planet "Tatooine"
+                          :jedis [{:name "Jorak Uln"
+                                   :homeworld "Korriban"}
+                                  {:name "Exar Kun"
+                                   :homeworld "Coruscant"}
+                                  {:name "Skere Kaan"
+                                   :homeworld "Coruscant"}
+                                  {:name "Na'daz"
+                                   :homeworld "Ryloth"}
+                                  {:name "Darth Bane"
+                                   :homeworld "Apatros"}]}))

-(defn hello-world []
-  [:h1 (:text @app-state)])
+(defn planet-monitor [planet]
+  [:h1 {:class "css-planet-monitor"}
+   (str "Obi-Wan currently on " planet)])

-#_(reagent/render-component [hello-world]
-                          (. js/document (getElementById "app")))
+(defn jedi-slot [jedi]
+  [:li {:class "css-slot"}
+   [:h3 (:name jedi)]
+   [:h6 (str "Homeworld: " (:homeworld jedi))]])
+
+(defn dark-jedi-list []
+  [:div {:class "css-root"}
+   [planet-monitor (:planet @app-state)]
+
+   [:section {:class "css-scrollable-list"}
+    [:ul {:class "css-slots"}
+     (for [jedi (:jedis @app-state)]
+       ^{:key (:name jedi)} [jedi-slot jedi])]
+
+    [:div {:class "css-scroll-buttons"}
+     [:button {:class "css-button-up"}]
+     [:button {:class "css-button-down"}]]]])
+
+(reagent/render-component
+  [dark-jedi-list]
+  (. js/document (getElementById "app")))

 (defn on-js-reload []
   ;; optionally touch your app-state to force rerendering depending on


Fix get-all-files

Fix get-all-files

Before it was written such that files in sub trees
were not included in the promise vector.

--- src/extremo/db.cljs
+++ src/extremo/db.cljs
@@ -76,18 +76,24 @@
         (get-entry-by-path filepath)
         (.then #(build-entry-data %)))))

+(defn walk-tree [tree]
+  (js/Promise. (fn [resolve reject]
+    (-> (.walk tree)
+       (.on "end" #(resolve %))
+       (.on "error" #(reject %))
+       (.start)))))
+
 (defn get-all-files
   "Returns a promise vector for each file in the repo."
   []
-  (let [rv (transient [])]
-    (-> (open-repo)
-        (.then #(.getMasterCommit %))
-        (.then #(.getTree %))
-        (.then (fn [tree]
-                 (-> (.walk tree)
-                     (.on "entry" #(conj! rv (build-entry-data %)))
-                     (.start))))
-        (.then #(js/Promise.all (persistent! rv))))))
+  (-> (open-repo)
+      (.then #(.getMasterCommit %))
+      (.then #(.getTree %))
+      (.then #(walk-tree %))
+      (.then (fn [all-entries]
+               (mapv #(build-entry-data %) all-entries)))
+      (.then #(js/Promise.all %))
+      (.catch #(js/console.error %))))

 ;; (-> (get-all-files)
 ;;     (.then #(js/console.log %)))


add in lifetime information for everything

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/aurora/runtime.cljs
+++ src/aurora/runtime.cljs
@@ -41,6 +41,72 @@
     (aset name->lifetime "ui/onDoubleClick" "external")
     (aset name->lifetime "ui/custom" "external")
     (aset name->lifetime "ui/onBlur" "external")
+
+    ;;editor
+    (aset name->lifetime "editor rules" "persistent")
+    (aset name->lifetime "editor clauses" "persistent")
+    (aset name->lifetime "editor clause fields" "persistent")
+    (aset name->lifetime "change clauses" "persistent")
+    (aset name->lifetime "draw madlib" "transient")
+    (aset name->lifetime "madlib strings" "persistent")
+    (aset name->lifetime "madlib placeholders" "persistent")
+    (aset name->lifetime "compiled clauses" "transient")
+    (aset name->lifetime "compiled clause-fields" "transient")
+    (aset name->lifetime "ui/editor-root" "persistent")
+    (aset name->lifetime "ui/editor-elem" "persistent")
+    (aset name->lifetime "ui/editor-child" "persistent")
+    (aset name->lifetime "ui/editor-attr" "persistent")
+    (aset name->lifetime "ui/editor-text" "persistent")
+    (aset name->lifetime "ui/editor-style" "persistent")
+    (aset name->lifetime "ui/editor-event-listener" "persistent")
+    (aset name->lifetime "ui/editor-computed-id" "persistent")
+    (aset name->lifetime "compile project" "external")
+    (aset name->lifetime "control external" "external")
+    (aset name->lifetime "active project" "transient")
+    (aset name->lifetime "projects" "persistent")
+    (aset name->lifetime "editor rule active" "transient")
+    (aset name->lifetime "rule editor active" "persistent")
+    (aset name->lifetime "submit rule" "transient")
+    (aset name->lifetime "cursor" "persistent")
+    (aset name->lifetime "cursor placeholder pos" "persistent")
+    (aset name->lifetime "remove clause" "transient")
+    (aset name->lifetime "add clause" "transient")
+    (aset name->lifetime "editor base clause types" "persistent")
+    (aset name->lifetime "editor clause types" "persistent")
+    (aset name->lifetime "add clause placeholders" "transient")
+    (aset name->lifetime "add madlib" "transient")
+    (aset name->lifetime "add new clause for madlib" "transient")
+    (aset name->lifetime "matcher state" "persistent")
+    (aset name->lifetime "matcher filter" "persistent")
+    (aset name->lifetime "matcher clause" "persistent")
+    (aset name->lifetime "found matcher clause type" "transient")
+    (aset name->lifetime "found matcher madlib" "transient")
+    (aset name->lifetime "draw madlib" "transient")
+    (aset name->lifetime "draw editor active elem" "persistent")
+
+
+    (aset name->lifetime "editing" "persistent")
+    (aset name->lifetime "cursor" "persistent")
+    (aset name->lifetime "cursor placeholder pos" "persistent")
+    (aset name->lifetime "rule editor active" "persistent")
+    (aset name->lifetime "active project" "persistent")
+    (aset name->lifetime "projects" "persistent")
+
+    ;;todomvc
+    (aset name->lifetime "todo-to-add" "persistent")
+    (aset name->lifetime "todo-to-edit" "persistent")
+    (aset name->lifetime "todo-filter" "persistent")
+    (aset name->lifetime "todo" "persistent")
+    (aset name->lifetime "todo-completed" "persistent")
+    (aset name->lifetime "todo-editing" "persistent")
+    (aset name->lifetime "current-toggle" "persistent")
+    (aset name->lifetime "todo-added" "transient")
+    (aset name->lifetime "todo-removed" "transient")
+    (aset name->lifetime "todo-displayed" "transient")
+    (aset name->lifetime "commit-todo" "transient")
+
+    ;;incrementer
+    (aset name->lifetime "incr" "persistent")

     (aset name->lifetime "ui/elem" "transient")
     (aset name->lifetime "ui/child" "transient")


(reverse (comp-paths depth)) in (defn gen) to improve performance

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -71,7 +71,7 @@
             ;; sequence of adding all possible complements at every possible
             ;; position at the bolt.
             (add-comps-to-bolt bolt model
-                               (comp-paths depth))))
+                               (reverse (comp-paths depth)))))
          (gen spec model depth
                (rest bolts)
                at-path))


add (take) in (add-bolt-at): seems to address rathole in (babel.test.en/be-called)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -102,21 +102,21 @@
                       comp-paths)]
             (log/debug (str "add-bolt-at:" ((:morph-ps model) bolt-at) "; comp-paths: " (string/join "," comp-paths)))
             (when (not (some empty? comp-bolts))
-              (lazy-seq
-               (filter #(not (= :fail %))
-                       (mapfn #(let [assoc (if (empty? path) %
-                                               (assoc-in bolt path %))]
-                                 assoc)
-                              (filter (fn [with-comps] (not (nil? with-comps)))
-                                      (add-comps bolt-at
-                                                 model
-                                                 comp-paths
-                                                 comp-bolts
-                                                 (+ 1 depth)
-                                                 max-depth
-                                                 top-bolt
-                                                 truncate?
-                                                 take-n))))))))))
+              (take take-n
+                    (filter #(not (= :fail %))
+                            (mapfn #(let [assoc (if (empty? path) %
+                                                    (assoc-in bolt path %))]
+                                      assoc)
+                                   (filter (fn [with-comps] (not (nil? with-comps)))
+                                           (add-comps bolt-at
+                                                      model
+                                                      comp-paths
+                                                      comp-bolts
+                                                      (+ 1 depth)
+                                                      max-depth
+                                                      top-bolt
+                                                      truncate?
+                                                      take-n))))))))))
 (defn generate
   "Return one (by default) or _n_ (using :take _n_) expressions matching spec _spec_ given the model _model_."
   [spec language-model


fix undefined fn (again)

fix undefined fn (again)

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -29,25 +29,6 @@
   ;; most arguments are simply discarded for italian.
   (parse/fo-ps expr (:morph-ps model)))

-(defn an-example []
-  (let [med (babel.italiano.grammar/medium)
-        med-reload (babel.italiano.grammar/medium-reloaded)]
-    (do
-      (take 5
-            (repeatedly
-             #(println
-               (morph (time (generate {:synsem {:cat :verb
-                                                :subcat []
-                                              :sem {:pred :know-s}}}
-                                      med-reload))))))
-      (take 5
-            (repeatedly
-             #(println
-               (morph (time (generate {:synsem {:cat :verb
-                                                :subcat []
-                                                :sem {:pred :know-s}}}
-                                      med)))))))))
-
 (defn fo-ps [expr]
   (parse/fo-ps expr fo))

@@ -73,6 +54,25 @@
      (if result
        (conj {:surface (fo result)}
              result)))))
+
+(defn an-example []
+  (let [med (babel.italiano.grammar/medium)
+        med-reload (babel.italiano.grammar/medium-reloaded)]
+    (do
+      (take 5
+            (repeatedly
+             #(println
+               (morph (time (generate {:synsem {:cat :verb
+                                                :subcat []
+                                              :sem {:pred :know-s}}}
+                                      med-reload))))))
+      (take 5
+            (repeatedly
+             #(println
+               (morph (time (generate {:synsem {:cat :verb
+                                                :subcat []
+                                                :sem {:pred :know-s}}}
+                                      med)))))))))

 (defonce tokenizer #"[ '\n,’».]")


delete documents from elasticsearch

delete documents from elasticsearch

--- src/brainbot/nozzle/esconnect.clj
+++ src/brainbot/nozzle/esconnect.clj
@@ -135,7 +135,7 @@
   (doseq [e delete-directories]
     (es-recursive-delete es-index (:id e)))
   (doseq [e delete-files]
-    nil)
+    (esd/delete es-index "doc" (:id e)))
   (doseq [e create-directories]
     (esd/put es-index "dir"
              (:id e)


Remove messaging require

Remove messaging require

--- src/cider_ci/dispatcher/retry.clj
+++ src/cider_ci/dispatcher/retry.clj
@@ -7,7 +7,6 @@
     [cider-ci.dispatcher.stateful-entity :as stateful-entity]
     [cider-ci.dispatcher.task :as task]
     [cider-ci.utils.config :as config :refer [get-config]]
-    [cider-ci.utils.messaging :as messaging]
     [cider-ci.utils.rdbms :as rdbms :refer [get-ds]]

     [clojure.java.jdbc :as jdbc]


Change a CircleCI to "Circle".

Change a CircleCI to "Circle".

--- src/circleci/web/views/common.clj
+++ src/circleci/web/views/common.clj
@@ -61,7 +61,7 @@
              [:body
               [:div#header_wrap
                [:div#header
-                [:h1#logo (link-to {:title "Go to CircleCI homepage"} "/" "CircleCI")]
+                [:h1#logo (link-to {:title "Go to Circle homepage"} "/" "Circle")]
                 (unordered-list {:id "nav"}
                                 [(link-to {:class "current_page"}
                                           "/" "Signup")


The Foundry now respects the first time only negative may ability.

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -229,9 +229,12 @@

    "The Foundry: Refining the Process"
    {:events
-    {:rez {:req (req (and (= (:type target) "ICE") (some #(= (:title %) (:title target)) (:deck corp))))
+    {:rez {:req (req (and (= (:type target) "ICE") ;; Did you rez and ice just now
+                          (some #(= (:title %) (:title target)) (:deck corp)) ;; Are there more copies in the dec
+                          (empty? (let [rezzed-this-turn (map first (turn-events state side :rez))]
+                                    (filter #(has? % :type "ICE") rezzed-this-turn))))) ;; Is this the first ice you've rezzed this turn
            :optional
-                {:prompt "Add another copy to HQ?" :once :per-turn
+                {:prompt "Add another copy to HQ?"
                  :effect (effect (move (some #(when (= (:title %) (:title target)) %) (:deck corp)) :hand)
                                  (shuffle! :deck))
                  :msg (msg "add a copy of " (:title target) " from R&D to HQ")}}}}


remove set of braces

remove set of braces

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -216,9 +216,9 @@
    "Spark Agency: Worldswide Reach"
    {:events
     {:rez {:req (req (has? target :subtype "Advertisement"))
-           {:once :per-turn
-            :effect (effect (lose :runner :credit 1))
-            :msg (msg "make the Runner lose 1 [Credits] by rezzing an advertisement")}}}}
+           :once :per-turn
+           :effect (effect (lose :runner :credit 1))
+           :msg (msg "make the Runner lose 1 [Credits] by rezzing an advertisement")}}}

    "Tennin Institute: The Secrets Within"
    {:abilities [{:msg "add 1 advancement counter on a card" :choices {:req #(= (first (:zone %)) :servers)}


Hayley no longer triggers after runner declines ability.

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -86,6 +86,8 @@
    "Hayley Kaplan: Universal Scholar"
    {:events {:runner-install
              {:optional {:prompt (msg "Install another " (:type target) " from Grip?") :once :per-turn
+                         :req (req (and (first-event state side :runner-install) ;; If this is the first installation of the turn
+                                        (some #(= (:type  %) (:type target)) (:hand runner)))) ;; and there are additional cards of that type in hand
                          :effect (req (let [type (:type target)]
                                         (resolve-ability
                                           state side


preliminary version of pdgm combination finished

--- src/clj/webapp/routes/pdgmcmp.clj
+++ src/clj/webapp/routes/pdgmcmp.clj
@@ -184,20 +184,12 @@
                        (= pos "noun")
                        (sparql/pdgmqry-sparql-noun language1 lpref1 valstring1)
                        :else (sparql/pdgmqry-sparql-fv language1 lpref1 valstring1))
-             ;;query-sparql-pr (replace query-sparql #"<" "<")
         req1 (http/get aama
                        {:query-params
                         {"query" query-sparql1 ;;generated sparql
                          "format" "csv"}})
                          ;;"format" "application/sparql-results+json"}})
                          ;;"format" "text"}})
-        ;;req-pr1 (replace (:body req1) #"<" "<")
-        ;;req-pr3 ( -> (:body req1)
-        ;;             (replace #"[<>]" "\"")
-        ;;             (replace #"\n" " "))
-        ;;lex-form1 (split req-pr3 #" " 2)
-        ;;lex1 (first lex-form1)
-        ;;pdgm1 (rest lex-form1)
         pdgm1 (replace (:body req1) #"\r\n" "%%")
         query-sparql2 (cond
                        (= pos "pro")
@@ -207,37 +199,28 @@
                        (= pos "noun")
                        (sparql/pdgmqry-sparql-noun language2 lpref2 valstring2)
                        :else (sparql/pdgmqry-sparql-fv language2 lpref2 valstring2))
-             ;;query-sparql-pr (replace query-sparql #"<" "<")
         req2 (http/get aama
                        {:query-params
                         {"query" query-sparql2 ;;generated sparql
                          "format" "csv"}})
                          ;;"format" "application/sparql-results+json"}})
                          ;;"format" "text"}})
-        ;;req-pr2 (replace (:body req2) #"<" "<")
-        ;;req-pr4 ( -> (:body req2)
-        ;;             (replace #"[<>]" "\"")
-        ;;             (replace #"\n" " "))
-        ;;lex-form2 (split req-pr4 #" " 2)
-        ;;lex2 (first lex-form2)
-        ;;pdgm2 (rest lex-form2)
         pdgm2 (replace (:body req2) #"\r\n" "%%")
-        ;;pdgmnames (str language1":"valstring1"("lex1")+"language2":"valstring2"("lex2")")
+        pdgm3 (replace (:body req2) #"," "\t\t")
         pdgmnames (str language1":"valstring1"+"language2":"valstring2)
         pdgmstr1 (str pdgm1 pdgm2)
         pdgmstr2 (replace pdgmstr1 #"," "_")
-        ;;pdgms-pr2 (str req-pr3  req-pr4)
-        ;;pdgms-pr2 (str pdgm1  pdgm2)
              ]
   (layout/common
    [:body
       [:h3 "PNames:"]
-       [:pre pdgmnames]
-       ;;[:pre req-pr1]
-       ;;[:pre req-pr2]
+    [:ol
+     [:li (str language1":"valstring1)]
+     [:li (str language2":"valstring2)]]
       [:h3 "Paradigms:"]
       [:p "(csv format)"]
-      [:pre pdgmstr2]
+      [:pre (:body req1)]
+      [:pre (:body req2)]
     [:hr]
       [:h3 "Parallel Display"]
      [:p "Choose PNG Values (comma-separated list)"]
@@ -255,8 +238,18 @@
                 {:title "PDGMS", :name "pdgmstr"}
                 [:option {:value pdgmstr2} "Paradigms"]
                 ]]]
-         [:tr [:td ]
-          [:td [:pre pdgmstr2]]]
+         [:tr [:td "Number: "]
+          [:td [:input#num.required
+                {:title "Choose Number Values.", :name "nmbr"}
+                ]]]
+         [:tr [:td "Person: " ]
+          [:td [:input#pers.required
+               {:title "Choose Person Values.", :name "pers"}
+                ]]]
+         [:tr [:td "Gender: " ]
+          [:td [:input#gen.required
+                {:title "Choose Gender Values.", :name "gen"}
+                ]]]
          ;;(submit-button "Get pdgm")
          [:tr [:td ]
           [:td [:input#submit
@@ -276,6 +269,9 @@
         ]
     (clojure.walk/keywordize-keys pmap)))

+;; The following is an attempt (unsuccessful so far) to directly translate
+;; into clojure the perl PrintCompPdgm subroutine from
+;; aama-data/pl/pdgm-fv-bil-tsv2table2.pl
 (defn handle-pdgmprlldisplay2
   [pdgmstr pdgmnames]
   (let [
@@ -307,102 +303,104 @@
          ;; *nrepl server webapp* buffer (emacs)
          (println pmap )
          [:hr]])
-      [:p "Enumeration of pngs and pmaps:"]
-      (for [png pngs]
-        [:pre png])
-      [:hr]
+;;      [:p "Enumeration of pngs and pmaps:"]
+;;      (for [png pngs]
+;;        [:pre png])
+;;      [:hr]
+      (def npgprint #{})
       [:table
       (for [png pngs]
-        (let [pngk (keyword png)]
-;;              pngprint (false)
-;;              pnum (0)]
-          (for [pmap pmaps]
+        [:tr
+         (let [pngk (keyword png)]
+           (def pngprint false)
+          (def pnum 0)
+          (for [pmap pmaps]
+            [:div
+;;             (def pngprint false)
+           (println pngprint)
 ;;            (let [pnum (inc pnum)]
             (if (pngk pmap)
-;;              (if (not pngprint)
-              [:tr
-                (let [
-                      ;;pngprint (true)
-                      npgs (split png #"_")]
+               (if (false? pngprint)
+  ;;               [:div
+                (let [npgs (split png #"_")]
                   [:div
                   (for [npg npgs]
                     [:td npg])
+;;                   (def pngprint true)
                   ;;needs to be 'while' for pnum > 2
-;;                  (if (> 1 pnum)
-;;                    ([:td ])
-                   [:td (pngk pmap)]])])
-;;              (if (pgnprint)
-;;                ([:td ])))))))
-            )))]
-;;          [:div
-;;           [:p "PNG + Pmap:"
-;;            [:ol
-;;             [:li "PNG = " pngk]
-;;             [:li "PMap = " [:p "(This key's value): " (pngk pmap)]]]]
-
+;;                  (if (> pnum 1)
+;;                    [:div
+;;                    [:td ]
+;;                   [:td  (pngk pmap)]])
+                [:td (str "a: " (pngk pmap))]
+                   (def pngprint true)
+                ]
+                  )
+;;                  ]
+               [:td (str "b: " (pngk pmap))]))
+;;            )
+             ]))])]
+;;              (if (true? pgnprint)
+                ;;[:td ])]))])))
       [:script {:src "js/goog/base.js" :type "text/javascript"}]
       [:script {:src "js/webapp.js" :type "text/javascript"}]
       [:script {:type "text/javascript"}
        "goog.require('webapp.core');"]])))

-(defn pdgmcomb
-  [pdgms header pnames pngs]
+;; The following is a work-around, limiting the number of pdgms to 2;
+;; It will be necessare to generalize this (perhaps along the lines
+;; initiated in handle-pdgmprlldisplay2) to n pdgms.
+(defn handle-pdgmprlldisplay3
+  [pdgmstr pdgmnames]
+  (let [
+        pngstring (slurp "pvlists/npg.clj")
+        pngs (split pngstring #" ")
+        pnames (split pdgmnames #"\+")
+        pdgms-sp (split pdgmstr #"%%" 2)
+        header (first pdgms-sp)
+        pbody (last pdgms-sp)
+        pdgms (split pbody (re-pattern (str header "%%")))
+        pmaps (for [pdgm pdgms] (pstring2map pdgm))
+        pmap1 (first pmaps)
+        pmap2 (last pmaps)
+        ]
     (layout/common
      [:body
-      [:h3 "Parallel Display" ]
+      [:h3 "Parallel Display of Paradigms:" ]
+      [:ol
       (for [pname pnames]
-        [:pre pname])
-      [:p "Header: "
-      [:pre header]]
-      [:hr][:hr]
-      [:p "Paradigms: "]
-      (for [pdgm pdgms]
-        (let [pdgm1  (replace pdgm #"(.*?,.*?,.*?),(.*?%%)" "$1 $2")
-              pdgm2 (replace pdgm1 #"%%" " ")
-              ;;pdgm3 (apply hash-map (split pdgm2 #" "))
-              ;;pdgm4 (clojure.walk/keywordize-keys pdgm3)
-              ]
-          [:p "Paradigm Base:"]
-          [:pre pdgm]
-          [:p "Paradigm => Map:"]
-        [:pre pdgm2][:hr]))
+        [:li pname])]
       [:hr]
-      [:p "Enumeration of pngs:"]
+      [:table
+       (let [heads (split header #"_")]
+         (for [head heads]
+           [:th head]))
       (for [png pngs]
-        [:pre png])
-      [:hr]
-      (for [png pngs]
-        (for [pdgm pdgms]
-
-          [:pre pdgm]))
+        [:tr
+         (let [pngk (keyword png)]
+            (if (pngk pmap1)
+                  [:div
+                   (let [npgs (split png #"_")]
+                     (for [npg npgs]
+                       [:td npg]))
+                   [:td (pngk pmap1)]
+                   [:td (pngk pmap2)]]
+              (if (pngk pmap2)
+                  [:div
+                   (let [npgs (split png #"_")]
+                     (for [npg npgs]
+                       [:td npg]))
+                   [:td (pngk pmap1)]
+                   [:td (pngk pmap2)]]
+                  )))])]
       [:script {:src "js/goog/base.js" :type "text/javascript"}]
       [:script {:src "js/webapp.js" :type "text/javascript"}]
       [:script {:type "text/javascript"}
-       "goog.require('webapp.core');"]]))
+       "goog.require('webapp.core');"]])))

-(defn handle-pdgmprlldisplay
-  [pdgmstr pdgmnames]
-  ;; format parallel display from combined csv + comma-separated num pers gen strings
-  (let [
-        ;;numvals (split nmbr #",")
-        ;;persvals (split pers #",")
-        ;;genvals (split gen #",")
-        ;;pngs (for [numval (str numvals)] (for [persval persvals] (for [genval genvals] (conj [] (str numval "\t" persval "\t" genval)))))
-        pngstring (slurp "pvlists/npg.clj")
-        pngs (split pngstring #" ")
-        pnames (split pdgmnames #"\+")
-        ;;pdgms-sp (replace pdgms #"\?" " ")
-        ;;pdgms-sp1 (replace pdgms #"^%%" "")
-        pdgms-sp (split pdgmstr #"%%" 2)
-        header (first pdgms-sp)
-        pdgms (split (last pdgms-sp) (re-pattern (str header "%%")))
-        ]
-    (pdgmcomb pdgms header pnames pngs)))
-
-
 (defroutes pdgmcmp-routes
   (GET "/pdgmcmp" [] (pdgmcmp))
   (POST "/pdgmcmpqry" [language1 language2 pos] (handle-pdgmcmpqry language1 language2 pos))
   (POST "/pdgmcmpdisplay" [pos language1 valstring1 language2 valstring2] (handle-pdgmcmpdisplay2 pos language1 valstring1 language2 valstring2))
-  (POST "/pdgmprlldisplay" [pdgmstr pdgmnames] (handle-pdgmprlldisplay2 pdgmstr pdgmnames))
+  (POST "/pdgmprlldisplay" [pdgmstr pdgmnames] (handle-pdgmprlldisplay3 pdgmstr pdgmnames))
   )


revamp cljs platform functions

revamp cljs platform functions

--- src/cljs/geschichte/platform.cljs
+++ src/cljs/geschichte/platform.cljs
@@ -18,23 +18,16 @@
 (defn put! [channel data]
   (.send channel (str data)))

-(defn- take! [message]
-  (log (str "data received:" (read-string message))))
+(defn- take-all! [channel func]
+  (aset channel "onmessage" (fn [m] (func (.-data m)))))

 (defn client-connect! [address]
   (let [channel (js/WebSocket. (str "ws://" address))]
-    (log (str "establishing websocket connection with " address))
     (doall
      (map #(aset channel (first %) (second %))
           [["onopen" (fn [] (log "channel opened"))]
-           ["onclose" (fn [] (log "channel closed"))]
-           ["onerror" (fn [e] (log (str "ERROR:" e)))]
-           ["onmessage" (fn [m] (let [data (.-data m)] (take! data)))]]))
-    (log "websocket loaded.")
+           ["onerror" (fn [e] (log (str "ERROR:" e)))]]))
     channel))

-#_(def the-channel (client-connect! "localhost:9090"))
-#_(put! the-channel {:type :publish
-         :user "user@mail.com"
-         :repo #uuid"22aa0537-6e66-43e4-bda2-2b4211e0e4ec"
-         :meta {:causal-order {#uuid "befcadd8-eb77-4565-b9fe-a77bac179aec" #{#uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3"}, #uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3" #{}, :root #uuid "b189b9f4-0901-4a39-a1c9-a0266254fbd3"}, :last-update #inst "2013-12-05T23:36:43.320-00:00", :head "master", :public true, :branches {"master" #{#uuid "befcadd8-eb77-4565-b9fe-a77bac179aec"}}, :schema {:version 1, :type "http://github.com/ghubber/geschichte"}, :pull-requests {}, :id #uuid "22aa0537-6e66-43e4-bda2-2b4211e0e4ec", :description "test repo"}})
+(defn start-server! [address]
+  (log (str "address: " address)))


clean up net examples

clean up net examples

--- src/block_chain/net.clj
+++ src/block_chain/net.clj
@@ -7,11 +7,15 @@
 (defn echo-handler [s info]
   (s/connect s s))

-#_(def server (tcp/start-server echo-handler {:port 10001}))
-(def client @(tcp/client {:host "localhost" :port 10001}))
+(defn server [port]
+  (tcp/start-server echo-handler {:port 10001}))

-#_(async/go
-  (loop [resp @(s/take! client)]
-    (println "got resp: " (apply str (map char resp)))
-    (recur @(s/take! client)))
-  (println "stopping listen loop"))
+(defn client [host port]
+  @(tcp/client {:host host :port port}))
+
+(defn listen [client handler]
+  (async/go
+    (loop [resp @(s/take! client)]
+      (println "got resp: " (apply handler resp))
+      (recur @(s/take! client)))
+    (println "stopping listen loop")))


Add and update ClojureDocs for data_processing_dsl.clj.

--- src/dsbdp/data_processing_dsl.clj
+++ src/dsbdp/data_processing_dsl.clj
@@ -14,7 +14,11 @@

 (def ^:dynamic *incremental-indicator-suffix* "#inc")

-(defn create-proc-sub-fn
+(defn- create-proc-sub-fn
+  "Create a sub part of a processing function.
+   The data-processing-definition will be processed recursively.
+   This function is responsible for actually resolving the given data processing functions.
+   The input symbol will be placed as first argument on the innermost terms."
   [data-processing-definition input]
   (into
     '()
@@ -102,7 +106,16 @@
     rules))

 (defn create-proc-fn
-  "Create a data processing function based on the given dsl-expression."
+  "Create a data processing function based on the given dsl-expression.
+   An example of a dsl-expression for processing a Clojure seq is given below:
+
+   {:output-type :clj-map
+    :rules [['myFloat '(nth 0)]
+            ['myStr '(clojure.string/lower-case (nth 1)) :string]
+            ['myRatio '(/ (nth 2) 100.0)]
+            ['myStr2 '(str (nth 3) (nth 4)) :string]]}
+
+   The resulting function will for the input [1.23 \"FOO\" 42 \"bar\" \"baz\"] produce the output {\"myFloat\" 1.23, \"myStr\" \"foo\", \"myRatio\" 0.42, \"myStr2\" \"barbaz\"}."
   [dsl-expression]
 ;  (println "Got DSL expression:" dsl-expression)
   (let [input-sym 'input
@@ -128,6 +141,8 @@
     data-processing-fn))

 (defn combine-proc-fns
+  "Based on the DSL expression dsl-expression, create a data processing function in which the processing rules starting at start-idx, inclusive, up to end-idx, non inclusive, are combined.
+   Please note that it is usually more appropriate to use combine-proc-fns-vec."
   [dsl-expression start-idx end-idx]
   (if (= 0 start-idx)
     (create-proc-fn
@@ -138,6 +153,9 @@
        :rules (subvec (:rules dsl-expression) start-idx end-idx)})))

 (defn combine-proc-fns-vec
+  "Based on the function mapping fn-mapping and the DSL expression dsl-expression, create a vector of data processing functions.
+   The mapping definition defines the number of processing rules to be included in each processing function.
+   For a vector of procssing rules [a b c d e f], a mapping definition [1 2 3] will result in the following association of processing rules to processing functions f_x: [f_1(a), f_2(b, c), f_3(d e f)]."
   [fn-mapping dsl-expression]
   (reduce
     (fn [v m]


Simplify exec code

Simplify exec code

--- library/src/doo/shell.clj
+++ library/src/doo/shell.clj
@@ -37,20 +37,16 @@
       (.close r)
       (.toString out))))

-(defn -exec
-  ([command-arr]
-    (.exec (Runtime/getRuntime) command-arr))
-  ([command-arr working-dir]
-   (.exec (Runtime/getRuntime) command-arr nil working-dir)))
+(defn- ^"[Ljava.lang.String;" str-array [xs]
+  (into-array String xs))

-(defn exec! [cmd exec-dir]
+(defn exec! [cmd ^File exec-dir]
   (let [windows? (= :windows (utils/get-os))
         windows-cmd (when windows? ["cmd" "/c"])
-        exec* (if exec-dir #(-exec % exec-dir) -exec)]
-    (->> cmd
-         (concat windows-cmd)
-         ^"[Ljava.lang.String;" (into-array String)
-         exec*)))
+        command-arr (str-array (concat windows-cmd cmd))]
+    (if exec-dir
+      (.exec (Runtime/getRuntime) command-arr nil exec-dir)
+      (.exec (Runtime/getRuntime) command-arr))))

 (defn capture-process! [process opts]
   (letfn [(capture! [stream]


Add 'error', 'deleting' status, and record errors.

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -15,7 +15,7 @@
   (:use [cavm.hashable :only (ahashable)])
   (:require [me.raynes.fs :as fs])
   (:require [cavm.db :refer [XenaDb]])
-  (:require [clojure.tools.logging :refer [spy trace info]])
+  (:require [clojure.tools.logging :refer [spy trace info warn]])
   (:require [taoensso.timbre.profiling :refer [profile p]])
   (:require [clojure.core.cache :as cache])
   (:require [cavm.h2-unpack-rows :as unpack])
@@ -677,15 +677,40 @@
      WHERE `dataset`.`id` = ?" id]
     (vec rows)))

+(defn- record-exception [dataset-id ex]
+  (jdbcd/with-query-results rows
+    ["SELECT `text` FROM `dataset` WHERE `dataset`.`id` = ?" dataset-id]
+    (let [[{text :text :or {text "{}"}}] rows
+          metadata (json/read-str text)]
+      (jdbcd/update-values :dataset ["`id` = ?" dataset-id] {:text
+                                                            (json/write-str
+                                                              (assoc metadata "error" (str ex))
+                                                              :escape-slash false)}))))
+
 (defn- with-load-status* [dataset-id func]
-  (jdbcd/update-values :dataset ["`id` = ?" dataset-id] {:status "loading"})
   (try
+    (jdbcd/update-values :dataset ["`id` = ?" dataset-id] {:status "loading"})
     (func)
-    (finally
-      (jdbcd/update-values :dataset ["`id` = ?" dataset-id] {:status "loaded"}))))
+    (jdbcd/update-values :dataset ["`id` = ?" dataset-id] {:status "loaded"})
+    (catch Exception ex
+      (warn ex "Error loading dataset")
+      (jdbcd/update-values :dataset ["`id` = ?" dataset-id] {:status "error"})
+      (record-exception dataset-id ex))))

 (defmacro with-load-status [dataset-id & body]
   `(with-load-status* ~dataset-id (fn [] ~@body))) ; XXX need :^once?
+
+(defn- with-delete-status* [dataset-id func]
+  (try
+    (jdbcd/update-values :dataset ["`id` = ?" dataset-id] {:status "deleting"})
+    (func)
+    (catch Exception ex
+      (warn ex "Error deleting dataset")
+      (jdbcd/update-values :dataset ["`id` = ?" dataset-id] {:status "error"})
+      (record-exception dataset-id ex))))
+
+(defmacro with-delete-status [dataset-id & body]
+  `(with-delete-status* ~dataset-id (fn [] ~@body))) ; XXX need :^once?

 ; jdbcd/transaction will create a closure of our parameters,
 ; so we can't pass in the matrix seq w/o blowing the heap. We
@@ -732,14 +757,15 @@
     (-> rows first :id)))

 (defn delete-dataset [dataset]
-  (jdbcd/transaction
-    (let [dataset-id (dataset-by-name dataset)]
-      (if dataset-id
-        (do
-          (clear-by-exp dataset-id)
-          (jdbcd/do-commands
-            (format "DELETE FROM `dataset` WHERE `id` = %d" dataset-id)))
-        (info "Did not delete unknown dataset" dataset)))))
+  (let [dataset-id (dataset-by-name dataset)]
+    (if dataset-id
+      (with-delete-status dataset-id
+        (jdbcd/transaction
+          (do
+            (clear-by-exp dataset-id)
+            (jdbcd/do-commands
+              (format "DELETE FROM `dataset` WHERE `id` = %d" dataset-id)))))
+      (info "Did not delete unknown dataset" dataset))))

 (defn create-db [file & [{:keys [classname subprotocol make-pool?]
                           :or {classname "org.h2.Driver"


Clean up

Clean up

--- src/joiner/core.clj
+++ src/joiner/core.clj
@@ -64,8 +64,9 @@
                    :command "_security"
                    :data security-settings))

-(defn security [& settings]
-  (if (nil? settings)
-    (get-security)
-    (set-security (first (merge settings)))))
+(defn security
+  ([]
+    (get-security))
+  ([settings]
+    (set-security settings)))


Use volatile! instead of atom in transducers

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -3529,12 +3529,12 @@
   provided."
   ([f]
    (fn [rf]
-     (let [ia (atom -1)]
+     (let [ia (volatile! -1)]
        (fn
          ([] (rf))
          ([result] (rf result))
          ([result input]
-            (let [i (swap! ia inc)
+            (let [i (vswap! ia inc)
                   v (f i input)]
               (if (nil? v)
                 result
@@ -3689,13 +3689,13 @@
   no collection is provided."
   ([n]
      (fn [rf]
-       (let [na (atom n)]
+       (let [na (volatile! n)]
          (fn
            ([] (rf))
            ([result] (rf result))
            ([result input]
               (let [n @na
-                    nn (swap! na dec)
+                    nn (vswap! na dec)
                     result (if (pos? n)
                              (rf result input)
                              result)]
@@ -3713,13 +3713,13 @@
   Returns a stateful transducer when no collection is provided."
   ([n]
      (fn [rf]
-       (let [na (atom n)]
+       (let [na (volatile! n)]
          (fn
            ([] (rf))
            ([result] (rf result))
            ([result input]
               (let [n @na]
-                (swap! na dec)
+                (vswap! na dec)
                 (if (pos? n)
                   result
                   (rf result input))))))))
@@ -3751,7 +3751,7 @@
   stateful transducer when no collection is provided."
   ([pred]
      (fn [rf]
-       (let [da (atom true)]
+       (let [da (volatile! true)]
          (fn
            ([] (rf))
            ([result] (rf result))
@@ -3760,7 +3760,7 @@
                 (if (and drop? (pred input))
                   result
                   (do
-                    (reset! da nil)
+                    (vreset! da nil)
                     (rf result input)))))))))
   ([pred coll]
      (let [step (fn [pred coll]
@@ -7776,12 +7776,12 @@
   transducer when no collection is provided."
   ([n]
      (fn [rf]
-       (let [ia (atom -1)]
+       (let [ia (volatile! -1)]
          (fn
            ([] (rf))
            ([result] (rf result))
            ([result input]
-              (let [i (swap! ia inc)]
+              (let [i (vswap! ia inc)]
                 (if (zero? (rem i n))
                   (rf result input)
                   result)))))))
@@ -7802,7 +7802,7 @@
   ([f]
      (fn [rf]
        (let [a (array-list)
-             pa (atom ::none)]
+             pa (volatile! ::none)]
          (fn
            ([] (rf))
            ([result]
@@ -7816,7 +7816,7 @@
            ([result input]
               (let [pval @pa
                     val (f input)]
-                (reset! pa val)
+                (vreset! pa val)
                 (if (or (keyword-identical? pval ::none)
                         (= val pval))
                   (do
@@ -8436,13 +8436,13 @@
   Returns a transducer when no collection is provided."
   ([]
    (fn [rf]
-     (let [pa (atom ::none)]
+     (let [pa (volatile! ::none)]
        (fn
          ([] (rf))
          ([result] (rf result))
          ([result input]
             (let [prior @pa]
-              (reset! pa input)
+              (vreset! pa input)
               (if (= prior input)
                 result
                 (rf result input))))))))


Updated contains? to return false for nil collection argument. Refs #14

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -518,7 +518,7 @@
   range of indexes. 'contains?' operates constant or logarithmic time;
   it will not perform a linear search for a value.  See also 'some'."
   [coll v]
-  (when-not (nil? coll) (-contains? coll v)))
+  (if (nil? coll) false (-contains? coll v)))

 (defn disj
   "disj[oin]. Returns a new set of the same (hashed/sorted) type, that


moved IRealized protocoal up near other protocols and fixed realized? docstring

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -125,6 +125,9 @@

 (defprotocol IPrintable
   (-pr-seq [o opts]))
+
+(defprotocol IRealized
+  (-realized? [d]))

 ;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;;
 (defn identical? [x y]
@@ -2525,9 +2528,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Delay ;;;;;;;;;;;;;;;;;;;;

-(defprotocol IRealized
-  (-realized? [d]))
-
 (deftype Delay [f state]

   IDeref
@@ -2559,10 +2559,11 @@
     (deref x)
     x))

-(defn realized? [d]
+(defn realized?
   "If d is a Delay, will return true if the delay fn has been realized, returns false if it has not,
   returns nil if d is not a Delay"
-  (-realized? d))
+  [d]
+    (-realized? d))

 (comment


remoteStorage works well and already uses indexeddb for caching & sync when offline

--- src/cljs/lokate/db.cljs
+++ src/cljs/lokate/db.cljs
@@ -1,4 +1,5 @@
-(ns lokate.db)
+(ns lokate.db
+  (:require [goog.object :as gobject]))

 (def db (atom nil))

@@ -65,15 +66,17 @@
         {:exports
          {:addCollection (fn [collection]
                             (.storeObject privClient "collection"
-                              (name (:id collection)) collection))
+                              (name (:id collection)) (clj->js collection)))
           :getCollections (fn []
-                            (.getAll privClient "collection"
-                              #(.log js/console (str "yea! " %))
-                              #(.log js/console (str "error " %))))}})))
+                            (-> privClient
+                              (.getAll "")
+                              (.then
+                                #(.log js/console (pr-str (js->clj %)))
+                                #(.log js/console (str "error " %)))))}})))

   (-> js/remoteStorage .-access (.claim "collections" "rw"))
   (.on js/remoteStorage "connecting" #(.log js/console "connecting"))
   (.on js/remoteStorage "authing" #(.log js/console "authing"))
-  (.on js/remoteStorage "error" #(.log js/console "error"))
+  (.on js/remoteStorage "error" #(.log js/console (str "error " %)))
   (.on js/remoteStorage "connected" #(.log js/console "connected"))
   (.connect js/remoteStorage "leblowl@5apps.com"))


Use log4j in the server module instead of output to the console

--- src/clouseau/server.clj
+++ src/clouseau/server.clj
@@ -65,10 +65,10 @@
                 (.replaceAll desc "\n" "
")))
         (catch Exception e
             ; print error message in case of any DB-related exception
-            (println-and-flush "read-description(): error accessing database '" (:subname (second product)) "'!")
-            (println-and-flush e)
+            (log/error "read-description(): error accessing database '" (:subname (second product)) "'!")
+            (log/error e)
             (.printStackTrace e)
-            (println "***********" package)
+            (log/error "package" package)
             nil)))  ; special value that will be handled later

 (defn try-to-read-description
@@ -85,8 +85,8 @@
         (db-interface/read-changes-statistic)
         (catch Exception e
             ; print error message in case of any DB-related exception
-            (println-and-flush "read-changes-statistic(): Error accessing database 'css_descriptions.db'!")
-            (println-and-flush e)
+            (log/error "read-changes-statistic(): Error accessing database 'css_descriptions.db'!")
+            (log/error e)
             nil)))  ; special value that will be handled later

 (defn read-changes
@@ -96,8 +96,8 @@
         (db-interface/read-changes)
         (catch Exception e
             ; print error message in case of any DB-related exception
-            (println-and-flush "read-changes(): Error accessing database 'css_descriptions.db'!")
-            (println-and-flush e)
+            (log/error "read-changes(): Error accessing database 'css_descriptions.db'!")
+            (log/error e)
             nil)))  ; special value that will be handled later

 (defn read-changes-for-user
@@ -107,8 +107,8 @@
         (db-interface/read-changes-for-user user-name)
         (catch Exception e
             ; print error message in case of any DB-related exception
-            (println-and-flush "read-changes-for-user(): Error accessing database 'css_descriptions.db'!")
-            (println-and-flush e)
+            (log/error "read-changes-for-user(): Error accessing database 'css_descriptions.db'!")
+            (log/error e)
             nil)))  ; special value that will be handled later

 (defn read-package-descriptions
@@ -128,8 +128,8 @@
                 ""     ; special value that will be handled later
                 desc)) ; (.replaceAll desc "\n" "
"))))
         (catch Exception e
-            (println-and-flush "read-ccs-description(): Error accessing database 'css_descriptions.db'!")
-            (println-and-flush e)
+            (log/error "read-ccs-description(): Error accessing database 'css_descriptions.db'!")
+            (log/error e)
             nil)))     ; special value that will be handled later

 (defn try-to-read-ccs-description
@@ -165,7 +165,7 @@
     (if (and (not-empty-parameter? package) (not-empty-parameter? description))
         (let [date (calendar/format-date-time (calendar/get-calendar))]
             (db-interface/store-changes user-name package description date)
-            (println-and-flush date user-name package)
+            (log/info date user-name package)
         )))

 (defn delete-package
@@ -182,11 +182,10 @@

 (defn log-request-information
     [request]
-    (println-and-flush "time:        " (.toString (new java.util.Date)))
-    (println-and-flush "addr:        " (request :remote-addr))
-    (println-and-flush "params:      " (request :params))
-    (println-and-flush "user-agent:  " ((request :headers) "user-agent"))
-    (println-and-flush ""))
+    (log/debug "time:        " (.toString (new java.util.Date)))
+    (log/debug "addr:        " (request :remote-addr))
+    (log/debug "params:      " (request :params))
+    (log/debug "user-agent:  " ((request :headers) "user-agent")))

 (defn get-products-without-descriptions
     [products package-descriptions]
@@ -291,7 +290,7 @@
                 (store-ccs-description (clojure.string/lower-case trimmed-package-name) new-description)
                 (generate-response trimmed-package-name new-description output-format new-user-name old-user-name)
                 (catch Exception e
-                    (println "Error writing into database 'ccs_descriptions.db':" e)
+                    (log/error e "Error writing into database 'ccs_descriptions.db':")
                     (generate-error-response trimmed-package-name old-user-name (str "Can not write into database file 'ccs_descriptions.db': " e))))
             (generate-response trimmed-package-name new-description output-format new-user-name old-user-name))))

@@ -306,9 +305,9 @@
           new-description     (get params "new-description")
           new-user-name       (get params "user-name")
           old-user-name       (get (get cookies "user-name") :value)]
-          (println-and-flush "Incoming cookies: " cookies)
+          (log/debug "Incoming cookies: " cookies)
           (let [response (process package new-description output-format new-user-name old-user-name)]
-              (println-and-flush "Outgoing cookies: " (get response :cookies))
+              (log/debug "Outgoing cookies: " (get response :cookies))
               response
           )))

@@ -317,7 +316,7 @@
     [request]
     (let [descriptions (read-all-descriptions)
           user-name    (get (get (request :cookies) "user-name") :value)]
-        ;(println-and-flush descriptions)
+        ;(log/debug descriptions)
         (-> (http-response/response (html-renderer/render-descriptions descriptions user-name))
             (http-response/content-type "text/html"))))

@@ -337,8 +336,8 @@
           user-name     (get (get (request :cookies) "user-name") :value)
           selected-user (get params "name")
           changes       (read-changes-for-user selected-user)]
-          (println "User name: " selected-user)
-          ;(println "User made changes: " changes)
+          (log/debug "User name: " selected-user)
+          ;(log/debug "User made changes: " changes)
         (-> (http-response/response (html-renderer/render-user changes selected-user user-name))
             (http-response/content-type "text/html"))))

@@ -348,15 +347,15 @@
     (let [params           (request :params)
           user-name        (get (get (request :cookies) "user-name") :value)
           selected-package (get params "package")]
-          (println "Selected package " selected-package)
-          (println "Operation        " operation)
+          (log/debug "Selected package " selected-package)
+          (log/debug "Operation        " operation)
           (case operation
                 :delete    (delete-package    selected-package)
                 :trim      (trim-package-name selected-package)
                 :lowercase (lowercase-package-name selected-package)
                 :none      nil)
           (let [packages    (read-all-packages-provided-by-ccs)]
-              (println "Packages         " (count packages))
+              (log/debug "Packages         " (count packages))
               (-> (http-response/response (html-renderer/render-admin-interface packages user-name))
                   (http-response/content-type "text/html")))))

@@ -365,16 +364,16 @@
      Special value nil / HTTP response 404 is returned in case of any I/O error."
     [file-name content-type]
     (let [file (new java.io.File "www" file-name)]
-        (println-and-flush "Returning file " (.getAbsolutePath file))
+        (log/debug "Returning file " (.getAbsolutePath file))
         (if (.exists file)
             (-> (http-response/response file)
                 (http-response/content-type content-type))
-            (println-and-flush "return-file(): can not access file: " (.getName file)))))
+            (log/debug "return-file(): can not access file: " (.getName file)))))

 (defn handler
     "Handler that is called by Ring for all requests received from user(s)."
     [request]
-    (println-and-flush "request URI: " (request :uri))
+    (log/info "request URI: " (request :uri))
     (let [uri (request :uri)]
         (condp = uri
             "/favicon.ico"       (return-file "favicon.ico" "image/x-icon")


optimize(ring-analytics): Only stringify response body when needed

--- systems/ring-analytics/src/containium/systems/ring_analytics.clj
+++ systems/ring-analytics/src/containium/systems/ring_analytics.clj
@@ -29,6 +29,12 @@
 (defn- dissoc!-body [map _]
   (dissoc! map :body))

+(defn- assoc!-string-body [{:keys [body] :as map}]
+  (if (or (nil? body) (string? body))
+    map
+   ;else
+    (assoc! map :body (str "Stringified: " body))))
+

 ;;; The public system API.

@@ -94,15 +100,16 @@
                                              :class (str (class response))
                                              :status 500
                                              :took took}
-                                            (-> (if (and (map? response) (:status response))
+                                           ;else, regular request:
+                                            (-> (if (map? response)
                                                   response
-                                                  {:body response})
+                                                 ;else, wrap in map:
+                                                  {:body response
+                                                   :status (if (nil? response) 404 #_else 200)})
                                                 (transient)
-                                                (assoc! :body (if (string? (:body response))
-                                                                (:body response)
-                                                                (str "Stringified: " (:body response))))
                                                 (assoc! :took took)
                                                 (response-filter request)
+                                                (assoc!-string-body)
                                                 (persistent!))))
                         (persistent!))]
       (try (store-request client app-name started processed)


Fixing CMR-3945 - Change the ISO MENDS schema location - PR fixes

--- umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/iso19115_2.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/iso19115_2.clj
@@ -34,7 +34,16 @@
    :xmlns:xlink "http://www.w3.org/1999/xlink"
    :xmlns:xs "http://www.w3.org/2001/XMLSchema"
    :xmlns:xsi "http://www.w3.org/2001/XMLSchema-instance"
-   :xsi:schemaLocation "http://earthdata.nasa.gov/schema/eos https://cdn.earthdata.nasa.gov/iso/eos/1.0/eos.xsd http://www.isotc211.org/2005/gco https://cdn.earthdata.nasa.gov/iso/gco/1.0/gco.xsd http://www.isotc211.org/2005/gmd https://cdn.earthdata.nasa.gov/iso/gmd/1.0/gmd.xsd http://www.isotc211.org/2005/gmi https://cdn.earthdata.nasa.gov/iso/gmi/1.0/gmi.xsd http://www.opengis.net/gml/3.2 https://cdn.earthdata.nasa.gov/iso/gml/1.0/gml.xsd http://www.isotc211.org/2005/gmx https://cdn.earthdata.nasa.gov/iso/gmx/1.0/gmx.xsd http://www.isotc211.org/2005/gsr https://cdn.earthdata.nasa.gov/iso/gsr/1.0/gsr.xsd http://www.isotc211.org/2005/gss https://cdn.earthdata.nasa.gov/iso/gss/1.0/gss.xsd http://www.isotc211.org/2005/gts https://cdn.earthdata.nasa.gov/iso/gts/1.0/gts.xsd http://www.isotc211.org/2005/srv https://cdn.earthdata.nasa.gov/iso/srv/1.0/srv.xsd"})
+   :xsi:schemaLocation (str "http://earthdata.nasa.gov/schema/eos https://cdn.earthdata.nasa.gov/iso/eos/1.0/eos.xsd "
+                            "http://www.isotc211.org/2005/gco https://cdn.earthdata.nasa.gov/iso/gco/1.0/gco.xsd "
+                            "http://www.isotc211.org/2005/gmd https://cdn.earthdata.nasa.gov/iso/gmd/1.0/gmd.xsd "
+                            "http://www.isotc211.org/2005/gmi https://cdn.earthdata.nasa.gov/iso/gmi/1.0/gmi.xsd "
+                            "http://www.opengis.net/gml/3.2 https://cdn.earthdata.nasa.gov/iso/gml/1.0/gml.xsd "
+                            "http://www.isotc211.org/2005/gmx https://cdn.earthdata.nasa.gov/iso/gmx/1.0/gmx.xsd "
+                            "http://www.isotc211.org/2005/gsr https://cdn.earthdata.nasa.gov/iso/gsr/1.0/gsr.xsd "
+                            "http://www.isotc211.org/2005/gss https://cdn.earthdata.nasa.gov/iso/gss/1.0/gss.xsd "
+                            "http://www.isotc211.org/2005/gts https://cdn.earthdata.nasa.gov/iso/gts/1.0/gts.xsd "
+                            "http://www.isotc211.org/2005/srv https://cdn.earthdata.nasa.gov/iso/srv/1.0/srv.xsd")})

 (def iso-topic-categories
   #{"farming"


Some error-handling, non-namespaced keys in tracker

--- src/main/clojure/clojure/tools/namespace/tracker.clj
+++ src/main/clojure/clojure/tools/namespace/tracker.clj
@@ -25,21 +25,39 @@
            (map #(dep/transitive-dependents deps %) new-names))))

 (defn tracker []
-  {::deps (dep/graph)
-   ::unload []
-   ::load []})
+  {:deps (dep/graph)
+   :unload []
+   :load []})

 (defn update [state files]
-  (let [deps (::deps state)
-        new-decls (keep tns/read-file-ns-decl files)
-        new-deps (update-deps deps new-decls)
-        changed (affected-namespaces deps new-decls)]
-    (assoc state
-      ::deps new-deps
-      ::unload (reverse (dep/topo-sort deps changed))
-      ::load (dep/topo-sort new-deps changed))))
+  (if (:error state)
+    state
+    (let [deps (:deps state)
+          new-decls (keep tns/read-file-ns-decl files)
+          new-deps (update-deps deps new-decls)
+          changed (affected-namespaces deps new-decls)]
+      (assoc state
+        :deps new-deps
+        :unload (reverse (dep/topo-sort deps changed))
+        :load (dep/topo-sort new-deps changed)))))

 (defn reload [state]
-  (doseq [n (::unload state)] (remove-ns n))
-  (doseq [n (::load state)] (require n :reload))
-  (dissoc state ::unload ::load))
+  (let [state (dissoc state :error)
+        {:keys [unload load]} state]
+    (cond
+      (seq unload)
+        (let [n (first unload)]
+          (prn (list 'remove-ns n))
+          (remove-ns n)
+          (recur (update-in state [:unload] rest)))
+      (seq load)
+        (let [n (first load)]
+          (prn (list 'require n :reload))
+          (let [r (try (require n :reload)
+                       true
+                       (catch Throwable t t))]
+            (if (true? r)
+              (recur (update-in state [:load] rest))
+              (assoc state :error r :unload [n]))))
+      :else
+        state)))


Lifecycles for Datomic info model.

Lifecycles for Datomic info model.

--- src/onyx/datomic/information_model.cljc
+++ src/onyx/datomic/information_model.cljc
@@ -163,4 +163,35 @@

     :onyx.plugin.datomic/commit-bulk-tx-async
     [:datomic/uri
-     :datomic/partition]}})
+     :datomic/partition]}
+
+   :lifecycle-entry
+   {:onyx.plugin.datomic/read-datoms
+    {:model
+     [{:task.lifecycle/name :read-datoms
+       :lifecycle/calls :onyx.plugin.datoms/read-datoms-calls}]}
+
+    :onyx.plugin.datomic/read-index-range
+    {:model
+     [{:task.lifecycle/name :read-index-datoms
+       :lifecycle/calls :onyx.plugin.datoms/read-index-range-calls}]}
+
+    :onyx.plugin.datomic/read-log
+    {:model
+     [{:task.lifecycle/name :read-log
+       :lifecycle/calls :onyx.plugin.datoms/read-log-calls}]}
+
+    :onyx.plugin.datomic/commit-tx
+    {:model
+     [{:task.lifecycle/name :write-datoms
+       :lifecycle/calls :onyx.plugin.datoms/write-tx-calls}]}
+
+    :onyx.plugin.datomic/commit-bulk-tx
+    {:model
+     [{:task.lifecycle/name :write-bulk-datoms
+       :lifecycle/calls :onyx.plugin.datomic/write-bulk-tx-calls}]}
+
+    :onyx.plugin.datomic/commit-bulk-tx-async
+    {:model
+     [{:task.lifecycle/name :write-bulk-datoms-async
+       :lifecycle/calls :onyx.plugin.datomic/write-bulk-tx-async-calls}]}}})


updated tests

updated tests

--- test/blog/article/article_file_datastore_impl_test.clj
+++ test/blog/article/article_file_datastore_impl_test.clj
@@ -1,6 +1,8 @@
 (ns blog.article.article-file-datastore-impl-test
   (:require [clojure.test :refer :all]
             [blog.article.article-file-datastore-impl :refer :all]))
+
+(def db-component {:recent-articles 5})

 (def test-article-names
   ["2014-05-01-next-post.md"
@@ -30,7 +32,7 @@
                        "2014-04-02-first-post.md"]})))

   (testing "sidebar-recent-article-data"
-    (is (= (sidebar-recent-article-data test-article-names)
+    (is (= (sidebar-recent-article-data db-component test-article-names)
            [{:code "2014-05-01-next-post", :title "Next Post",
              :month-name "May", :day "01", :month "05", :year "2014"}
             {:code "2014-04-15-april-post", :title "April Post",
@@ -39,7 +41,7 @@
              :month-name "April", :day "02", :month "04", :year "2014"}])))

   (testing "sidebar-archive-data"
-    (is (= (sidebar-archive-data test-article-names)
+    (is (= (sidebar-archive-data db-component test-article-names)
            [{:code "2014-05", :title "",
              :month-name "May", :month "05", :year "2014"}
             {:code "2014-04", :title "",


more vjs debug

more vjs debug

--- src/prais2/components/video_player.cljc
+++ src/prais2/components/video_player.cljc
@@ -1,39 +1,42 @@
 (ns prais2.components.video-player
   (:require [rum.core :as rum :include-macros true]))

+
 (def init-video-js
-  {
-   :did-mount (fn [state]
-                #?(:cljs (do (.videojs js/window "video1"
-                                       (clj->js {} #_{:playbackRates [1 1.5 2]})
-                                       #(prn "video-1 initialised"))))
-                state)
-   :should-update  (fn [_ _] false)
+  {:did-mount     (fn [state]
+                    #?(:cljs (do (.videojs js/window "video1"
+                                           (clj->js {} #_{:playbackRates [1 1.5 2]})
+                                           #(do (prn "video-1 initialised")
+                                                (.log js/console (:video-id (first (:rum/args state))))))))
+                    state)
+   :should-update (fn [_ _] false)
    })

 (rum.core/defc video-js < init-video-js
-               [{:keys [video-id src controls preload poster track-src]
-                          :or   {controls true preload "auto"}}]
-               (letfn [(vid [s] (str video-id "-" s))]
-                 [:figure.videojs-container {:id (vid "container")}
+  [{:keys [video-id src controls preload poster track-src]
+    :or   {controls true preload "auto"}}]
+  (letfn [(vid [s] (str video-id "-" s))]
+    [:figure.videojs-container {:id (vid "container")}

-                  [:video.video-js.vjs-default-skin.vjs-big-play-centered
-                   {:key      1
-                    :id       video-id
-                    :poster   poster
-                    :controls controls
-                    :preload  preload
-                    :style    {:background-color "rgba(255,255, 255, 0)"
-                               :max-width "600px"
-                               :width "480px"
-                               :height "272px"}}
-                   [:source {:key  1
-                             :src  src
-                             :type "video/mp4"}]
-                   #_[:track {:key     2
-                            :src     track-src
-                            :label   "captions-on"
-                            :kind    "captions"
-                            :srclang "en"}]]]))
+     [:video.video-js.vjs-default-skin.vjs-big-play-centered
+      {:key      1
+       :id       video-id
+       :poster   poster
+       :controls controls
+       :preload  preload
+       :src      src
+       :style    {:background-color "rgba(255,255, 255, 0)"
+                  :max-width        "600px"                 ; "600px" ; responsive isn't good in video-js
+                  :width            "480px"
+                  :height           "272px"
+                  }
+       ;:dangerouslySetInnerHTML
+       #_{:__html
+          (str "<source src=\"" src "\"
+                    type=\"video/mp4\">
+                    <track src=\"" track-src "\"
+                    label=\"captions-on\"
+                    kind=\"captions-off\">")}}
+      ]]))


Add generative tests for flow condition validation

--- test/onyx/flow_conditions/flow_conditions_gen_test.clj
+++ test/onyx/flow_conditions/flow_conditions_gen_test.clj
@@ -5,6 +5,7 @@
             [clojure.test :refer :all]
             [com.gfredericks.test.chuck :refer [times]]
             [com.gfredericks.test.chuck.clojure-test :refer [checking]]
+            [onyx.static.validation :as v]
             [onyx.flow-conditions.fc-routing :as r]
             [onyx.peer.task-compile :as c]
             [onyx.api]))
@@ -390,3 +391,33 @@
          exclusions (mapcat :flow/exclude-keys (filter :pred/val fcs))
          filtered-segment (reduce dissoc segment exclusions)]
      (is (= filtered-segment (r/flow-conditions-transform segment routes fcs event))))))
+
+(deftest none-placed-after-all
+  (checking
+    ":flow/to :none placed after :flow/to :all"
+    (times 50)
+    [fcs-all (gen/not-empty
+               (gen/vector (->> :a
+                                (flow-condition-gen)
+                                (flow-to-all-gen))))
+     fcs-none (gen/not-empty
+                (gen/vector (->> :a
+                                 (flow-condition-gen)
+                                 (flow-to-none-gen))))]
+    (let [fcs (into [] (concat fcs-none fcs-all))]
+      (is (thrown? Exception (v/validate-flow-conditions fcs []))))))
+
+(deftest none-placed-before-other
+  (checking
+    ":flow/to :none placed first if there is no :flow/to :all"
+    (times 50)
+    [fcs-other (gen/not-empty
+               (gen/vector (->> :a
+                                (flow-condition-gen)
+                                (flow-to-tasks-gen))))
+     fcs-none (gen/not-empty
+                (gen/vector (->> :a
+                                 (flow-condition-gen)
+                                 (flow-to-none-gen))))]
+    (let [fcs (into [] (concat fcs-other fcs-none))]
+      (is (thrown? Exception (v/validate-flow-conditions fcs []))))))


[#4] Api pagination example

[#4] Api pagination example

--- stub/fetch-data/src/fetch_data/core.clj
+++ stub/fetch-data/src/fetch_data/core.clj
@@ -10,13 +10,17 @@
               :private-key-file (format "/Users/jonasenlund/dev/akvo/akvo-flow-server-config/%1$s/%1$s.p12" flow-instance)
               :port 443})

+;; Large one: 570000 QAs
+;; (def form-id 5021286)
+
+;; Smaller one: 35000 QAs
+(def form-id 1060927)
+
+
+
 (comment

-  ;; Large one: 570000 QAs
-  (def form-id 5021286)

-  ;; Smaller one: 35000 QAs
-  (def form-id 1060927)

   ;; Attempt 1: Pull all form instances and responses in one go: 40s
   (gae/with-datastore [ds ds-spec]
@@ -64,4 +68,62 @@
                                        (map #(-> % .getKey .getId) form-instance-batch))}
                         {:chunk-size 300})))))

+  ;;; Pagination
+
+  (def MAX_PAGE_SIZE 300)
+
+  (defn form-instance-entity->map [form-instance]
+    {:id (-> form-instance .getKey .getId str)
+     :form-id (.getProperty form-instance "surveyId")
+     :surveyal-time (.getProperty form-instance "surveyalTime")
+     :submitter (.getProperty form-instance "submitterName")
+     :submission-date (.getProperty form-instance "collectionDate")
+     :device-identifier (.getProperty form-instance "deviceIdentifier")
+     :data-point-id (.getProperty form-instance "surveyedLocaleId")
+     :identifier (.getProperty form-instance "surveyedLocaleIdentifier")
+     :display-name (.getProperty form-instance "surveyedLocaleDisplayName")})
+
+  (defn do-fetch [page-size cursor]
+    (gae/with-datastore [ds ds-spec]
+      (let [page-size (if (<= page-size MAX_PAGE_SIZE)
+                        page-size
+                        MAX_PAGE_SIZE)
+            form-instances-iterator (.iterator (q/result ds
+                                                         {:kind "SurveyInstance"
+                                                          :filter (q/= "surveyId" form-id)}
+                                                         {:start-cursor cursor
+                                                          :chunk-size page-size
+                                                          :limit page-size}))
+            form-instances-seq (mapv form-instance-entity->map (iterator-seq form-instances-iterator))
+            cursor (.getCursor form-instances-iterator)
+            answers (reduce (fn [form-instance-answers form-instance-batch]
+                              (reduce (fn [fia answer]
+                                        (assoc-in fia
+                                                  [(str (.getProperty answer "surveyInstanceId"))
+                                                   (.getProperty answer "questionID")
+                                                   (or (.getProperty answer "iteration") 0)]
+                                                  (or (.getProperty answer "value")
+                                                      (.getProperty answer "valueText"))))
+                                      form-instance-answers
+                                      (q/result ds
+                                                {:kind "QuestionAnswerStore"
+                                                 :filter (q/in "surveyInstanceId"
+                                                               (map (comp #(Long/parseLong %) :id) form-instance-batch))}
+                                                {:chunk-size 300})))
+                            {}
+                            (partition-all 30 form-instances-seq))]
+        {:form-instances (mapv (fn [form-instance]
+                                 (assoc form-instance
+                                        :responses
+                                        (get answers (:id form-instance))))
+                               form-instances-seq)
+         :cursor cursor})))
+
+
+  (def res1 (do-fetch 2 nil)) res1
+  (def res2 (do-fetch 2 (:cursor res1)))
+
+  res1
+  res2
+
   )


shortened tabular macro and removed unused :use statements

--- src/midje/sweet.clj
+++ src/midje/sweet.clj
@@ -2,9 +2,7 @@

 (ns midje.sweet
   (:use clojure.test
-        [clojure.contrib.ns-utils :only [immigrate]]
-        [clojure.contrib.pprint :only [pprint]]
-        [clojure.contrib.seq :only [separate]])
+        [clojure.contrib.ns-utils :only [immigrate]])

   (:use [midje production-mode metaconstants]
         midje.midje-forms.recognizing
@@ -96,10 +94,10 @@

 (defmacro tabular [& forms]
   (let [{:keys [fact-form binding-maps map-order]} (dissect-fact-table forms)
-        substitute (fn [bindings]
-                     (subst fact-form bindings))
-        numbered (fn [form]
-                   (form-with-copied-line-numbers form fact-form))
-        expect-forms (map (comp macroexpand numbered substitute) binding-maps)
+        expect-forms (map (comp macroexpand
+        		        #(form-with-copied-line-numbers % fact-form)
+        		        (partial subst fact-form)) binding-maps)
         result (add-binding-annotations expect-forms binding-maps map-order)]
     `(do ~@result)))
+
+


prevent reloading of mount.core ns - fix https://github.com/tolitius/mount/issues/106

--- src/mount/core.cljc
+++ src/mount/core.cljc
@@ -1,4 +1,5 @@
 (ns mount.core
+  #?(:clj {:clojure.tools.namespace.repl/load false}) ; prevent reloading of this ns
   #?(:clj (:require [mount.tools.macro :refer [on-error throw-runtime] :as macro]
                     [mount.tools.macrovich :refer [deftime]]
                     [mount.tools.logger :refer [log]]
@@ -16,10 +17,6 @@
 (defonce ^:private mode (atom :clj))
 (defonce ^:private meta-state (atom {}))
 (defonce ^:private running (atom {}))                      ;; to clean dirty states on redefs
-
-;; supporting tools.namespace: (disable-reload!)
-#?(:clj
-    (alter-meta! *ns* assoc ::load false)) ;; to exclude the dependency

 (defn- make-state-seq [state]
   (or (:order (@meta-state state))