Fix shape size locking wrong behavior.

Fix shape size locking wrong behavior.

It does not worked properly when user
explicitly locks the size proportions
on the measures element options.

--- frontend/src/uxbox/main/ui/shapes/selection.cljs
+++ frontend/src/uxbox/main/ui/shapes/selection.cljs
@@ -50,176 +50,191 @@

 ;; --- Resize Implementation

+(defn- calculate-scale-ratio
+  "Calculate the scale factor from one shape to an other."
+  [origin final]
+  [(/ (:width final) (:width origin))
+   (/ (:height final) (:height origin))])
+
+(defn generate-resize-matrix
+  "Generate the resize transformation matrix given
+  a corner-id, shape and the scale factor vector."
+  [vid shape [scalex scaley]]
+  (case vid
+    :top-left
+    (-> (gmt/matrix)
+        (gmt/translate (+ (:x2 shape))
+                       (+ (:y2 shape)))
+        (gmt/scale scalex scaley)
+        (gmt/translate (- (:x2 shape))
+                       (- (:y2 shape))))
+
+    :top-right
+    (-> (gmt/matrix)
+        (gmt/translate (+ (:x1 shape))
+                       (+ (:y2 shape)))
+        (gmt/scale scalex scaley)
+        (gmt/translate (- (:x1 shape))
+                       (- (:y2 shape))))
+
+    :top
+    (-> (gmt/matrix)
+        (gmt/translate (+ (:x1 shape))
+                       (+ (:y2 shape)))
+        (gmt/scale scalex scaley)
+        (gmt/translate (- (:x1 shape))
+                       (- (:y2 shape))))
+
+    :bottom-left
+    (-> (gmt/matrix)
+        (gmt/translate (+ (:x2 shape))
+                       (+ (:y1 shape)))
+        (gmt/scale scalex scaley)
+        (gmt/translate (- (:x2 shape))
+                       (- (:y1 shape))))
+
+    :bottom-right
+    (-> (gmt/matrix)
+        (gmt/translate (+ (:x1 shape))
+                       (+ (:y1 shape)))
+        (gmt/scale scalex scaley)
+        (gmt/translate (- (:x1 shape))
+                       (- (:y1 shape))))
+
+    :bottom
+    (-> (gmt/matrix)
+        (gmt/translate (+ (:x1 shape))
+                       (+ (:y1 shape)))
+        (gmt/scale scalex scaley)
+        (gmt/translate (- (:x1 shape))
+                       (- (:y1 shape))))
+
+    :right
+    (-> (gmt/matrix)
+        (gmt/translate (+ (:x1 shape))
+                       (+ (:y1 shape)))
+        (gmt/scale scalex scaley)
+        (gmt/translate (- (:x1 shape))
+                       (- (:y1 shape))))
+
+    :left
+    (-> (gmt/matrix)
+        (gmt/translate (+ (:x2 shape))
+                       (+ (:y1 shape)))
+        (gmt/scale scalex scaley)
+        (gmt/translate (- (:x2 shape))
+                       (- (:y1 shape))))))
+
+
+(defn- resize-shape
+  [vid shape {:keys [x y] :as point} ctrl?]
+  (case vid
+    :top-left
+    (let [width (- (:x2 shape) x)
+          height (- (:y2 shape) y)
+          proportion (:proportion shape)]
+      (assoc shape
+             :width width
+             :height (if ctrl? (/ width proportion) height)))
+
+    :top-right
+    (let [width (- x (:x1 shape))
+          height (- (:y2 shape) y)
+          proportion (:proportion shape)]
+      (assoc shape
+             :width width
+             :height (if ctrl? (/ width proportion) height)))
+
+    :top
+    (let [width (- (:x2 shape) (:x1 shape))
+          height (- (:y2 shape) y)
+          proportion (:proportion shape)]
+      (assoc shape
+             :width width
+             :height (if ctrl? (/ width proportion) height)))
+
+    :bottom-left
+    (let [width (- (:x2 shape) x)
+          height (- y (:y1 shape))
+          proportion (:proportion shape)]
+      (assoc shape
+             :width width
+             :height (if ctrl? (/ width proportion) height)))
+
+    :bottom-right
+    (let [width (- x (:x1 shape))
+          height (- y (:y1 shape))
+          proportion (:proportion shape)]
+      (assoc shape
+             :width width
+             :height (if ctrl? (/ width proportion) height)))
+
+    :bottom
+    (let [width (- (:x2 shape) (:x1 shape))
+          height (- y (:y1 shape))
+          proportion (:proportion shape)]
+      (assoc shape
+             :width width
+             :height (if ctrl? (/ width proportion) height)))
+
+    :left
+    (let [width (- (:x2 shape) x)
+          height (- (:y2 shape) (:y1 shape))
+          proportion (:proportion shape)]
+      (assoc shape
+             :width width
+             :height (if ctrl? (/ width proportion) height)))
+
+    :right
+    (let [width (- x (:x1 shape))
+          height (- (:y2 shape) (:y1 shape))
+          proportion (:proportion shape)]
+      (assoc shape
+             :width width
+             :height (if ctrl? (/ width proportion) height)))))
+
 (defn- start-resize
   [vid ids shape]
-  (letfn [(gen-matrix [shape {scalex :x scaley :y}]
-            (case vid
-              :top-left
-              (-> (gmt/matrix)
-                  (gmt/translate (+ (:x2 shape))
-                                 (+ (:y2 shape)))
-                  (gmt/scale scalex scaley)
-                  (gmt/translate (- (:x2 shape))
-                                 (- (:y2 shape))))
-
-              :top-right
-              (-> (gmt/matrix)
-                  (gmt/translate (+ (:x1 shape))
-                                 (+ (:y2 shape)))
-                  (gmt/scale scalex scaley)
-                  (gmt/translate (- (:x1 shape))
-                                 (- (:y2 shape))))
-
-              :top
-              (-> (gmt/matrix)
-                  (gmt/translate (+ (:x1 shape))
-                                 (+ (:y2 shape)))
-                  (gmt/scale scalex scaley)
-                  (gmt/translate (- (:x1 shape))
-                                 (- (:y2 shape))))
-
-              :bottom-left
-              (-> (gmt/matrix)
-                  (gmt/translate (+ (:x2 shape))
-                                 (+ (:y1 shape)))
-                  (gmt/scale scalex scaley)
-                  (gmt/translate (- (:x2 shape))
-                                 (- (:y1 shape))))
-
-              :bottom-right
-              (-> (gmt/matrix)
-                  (gmt/translate (+ (:x1 shape))
-                                 (+ (:y1 shape)))
-                  (gmt/scale scalex scaley)
-                  (gmt/translate (- (:x1 shape))
-                                 (- (:y1 shape))))
-
-              :bottom
-              (-> (gmt/matrix)
-                  (gmt/translate (+ (:x1 shape))
-                                 (+ (:y1 shape)))
-                  (gmt/scale scalex scaley)
-                  (gmt/translate (- (:x1 shape))
-                                 (- (:y1 shape))))
-
-              :right
-              (-> (gmt/matrix)
-                  (gmt/translate (+ (:x1 shape))
-                                 (+ (:y1 shape)))
-                  (gmt/scale scalex scaley)
-                  (gmt/translate (- (:x1 shape))
-                                 (- (:y1 shape))))
-
-              :left
-              (-> (gmt/matrix)
-                  (gmt/translate (+ (:x2 shape))
-                                 (+ (:y1 shape)))
-                  (gmt/scale scalex scaley)
-                  (gmt/translate (- (:x2 shape))
-                                 (- (:y1 shape))))
-              ))
-
-          (calculate-ratio [orig-shape {:keys [width height] :as shape}]
-            (let [result {:x (/ width (:width orig-shape))
-                          :y (/ height (:height orig-shape))}]
-              result))
-
-          (accumulate-width [shape [{:keys [x y] :as point} ctrl?]]
-            (case vid
-              :top-left
-              (let [width (- (:x2 shape) x)
-                    height (- (:y2 shape) y)
-                    proportion (:proportion shape)]
-                (assoc shape
-                       :width width
-                       :height (if ctrl? (/ width proportion) height)))
-
-              :top-right
-              (let [width (- x (:x1 shape))
-                    height (- (:y2 shape) y)
-                    proportion (:proportion shape)]
-                (assoc shape
-                       :width width
-                       :height (if ctrl? (/ width proportion) height)))
-
-              :top
-              (let [width (- (:x2 shape) (:x1 shape))
-                    height (- (:y2 shape) y)
-                    proportion (:proportion shape)]
-                (assoc shape
-                       :width width
-                       :height (if ctrl? (/ width proportion) height)))
-
-              :bottom-left
-              (let [width (- (:x2 shape) x)
-                    height (- y (:y1 shape))
-                    proportion (:proportion shape)]
-                (assoc shape
-                       :width width
-                       :height (if ctrl? (/ width proportion) height)))
-
-              :bottom-right
-              (let [width (- x (:x1 shape))
-                    height (- y (:y1 shape))
-                    proportion (:proportion shape)]
-                (assoc shape
-                       :width width
-                       :height (if ctrl? (/ width proportion) height)))
-
-              :bottom
-              (let [width (- (:x2 shape) (:x1 shape))
-                    height (- y (:y1 shape))
-                    proportion (:proportion shape)]
-                (assoc shape
-                       :width width
-                       :height (if ctrl? (/ width proportion) height)))
-
-              :left
-              (let [width (- (:x2 shape) x)
-                    height (- (:y2 shape) (:y1 shape))
-                    proportion (:proportion shape)]
-                (assoc shape
-                       :width width
-                       :height (if ctrl? (/ width proportion) height)))
-
-              :right
-              (let [width (- x (:x1 shape))
-                    height (- (:y2 shape) (:y1 shape))
-                    proportion (:proportion shape)]
-                (assoc shape
-                       :width width
-                       :height (if ctrl? (/ width proportion) height)))
-
-              ))
-          (on-resize [shape scale]
-            (let [mt (gen-matrix shape scale)
-                  xf (map #(uds/apply-temporal-resize % mt))]
-              (apply st/emit! (sequence xf ids))))
+  (letfn [(on-resize [shape [point lock?]]
+            (let [result (resize-shape vid shape point lock?)
+                  scale (calculate-scale-ratio shape result)
+                  mtx (generate-resize-matrix vid shape scale)
+                  xfm (map #(uds/apply-temporal-resize % mtx))]
+              (apply st/emit! (sequence xfm ids))))

           (on-end []
-            (apply st/emit! (map uds/apply-resize ids)))]
+            (apply st/emit! (map uds/apply-resize ids)))
+
+          ;; Unifies the instantaneous proportion lock modifier
+          ;; activated by Ctrl key and the shapes own proportion
+          ;; lock flag that can be activated on element options.
+          (normalize-proportion-lock [[point ctrl?]]
+            (let [proportion-lock? (:proportion-lock shape)]
+              [point (or proportion-lock? ctrl?)]))
+
+          ;; Applies alginment to point if it is currently
+          ;; activated on the current workspace
+          (apply-grid-alignment [point]
+            (if @refs/selected-alignment
+              (uwrk/align-point point)
+              (rx/of point)))
+
+          ;; Apply the current zoom factor to the point.
+          (apply-zoom [point]
+            (gpt/divide point @refs/selected-zoom))]

     (let [shape  (->> (geom/shape->rect-shape shape)
                       (geom/size))
-
           stoper (->> streams/events
                       (rx/filter uev/mouse-up?)
                       (rx/take 1))
-
           stream (->> streams/canvas-mouse-position
-                      (rx/map #(gpt/divide % @refs/selected-zoom))
-                      (rx/mapcat (fn [point]
-                                   (if @refs/selected-alignment
-                                     (uwrk/align-point point)
-                                     (rx/of point))))
                       (rx/take-until stoper)
+                      (rx/map apply-zoom)
+                      (rx/mapcat apply-grid-alignment)
                       (rx/with-latest vector streams/mouse-position-ctrl)
-                      (rx/scan accumulate-width shape)
-                      (rx/map (partial calculate-ratio shape)))]
-      (rx/subscribe stream
-                    (partial on-resize shape)
-                    nil
-                    on-end))))
+                      (rx/map normalize-proportion-lock))]
+      (rx/subscribe stream (partial on-resize shape) nil on-end))))

 ;; --- Controls (Component)


Skip empty pods.

Skip empty pods.

--- Alphabot/src/alphabot/core.clj
+++ Alphabot/src/alphabot/core.clj
@@ -34,7 +34,10 @@
                     ls)))
         (take 2
             (filter
-                (fn [t] (= (:tag t) :pod))
+                (fn [t] (and
+                        (= (:tag t) :pod)
+                        (not (empty? (get-all-plaintext-lines t)))
+                        ))
                 (:content xmldoc)))))

 (defn make-query-url [query appid]


Fix #81 WebDAV not unmounting

Fix #81 WebDAV not unmounting

--- Clojure/src/ambly/repl/jsc.clj
+++ Clojure/src/ambly/repl/jsc.clj
@@ -292,24 +292,25 @@
   {:pre [(or (string? path) (instance? File path))]}
   (form-ambly-import-script-expr-js (str "'" path "'")))

-(defn tear-down
-  [repl-env]
-  (when-let [webdav-mount-point @(:webdav-mount-point repl-env)]
-    (sh 1000 -1 "umount" webdav-mount-point))
-  (when-let [socket @(:socket repl-env)]
-    (close-socket socket)))
+(defn- umount-webdav
+  "Unmounts WebDAV, returning true upon success."
+  [webdav-mount-point]
+  {:pre (string? webdav-mount-point)}
+  (or
+    (not (.exists (io/file webdav-mount-point)))
+    (= 0 (sh 5000 -1 "umount" webdav-mount-point))
+    (= 0 (sh 5000 -1 "umount" "-f" webdav-mount-point))))

 (defn- mount-webdav
+  "Mounts WebDAV, throwing upon failure."
   [repl-env bonjour-name endpoint-address endpoint-port]
   {:pre [(map? repl-env) (is-ambly-bonjour-name? bonjour-name)
          (string? endpoint-address) (number? endpoint-port)]}
   (let [webdav-mount-point (str "/Volumes/Ambly-" (format "%08X" (hash bonjour-name)))
         output-dir (io/file webdav-mount-point)
-        webdav-endpoint (str "http://" endpoint-address ":" endpoint-port)
-        unmount-if #(if (.exists output-dir)
-                     (if-not (<= 0 (sh 1000 -1 "umount" webdav-mount-point) 1)
-                       (throw (IOException. (str "Unable to unmount previous WebDAV mount at " webdav-mount-point)))))]
-    (unmount-if)
+        webdav-endpoint (str "http://" endpoint-address ":" endpoint-port)]
+    (when-not (umount-webdav webdav-mount-point)
+      (throw (IOException. (str "Unable to unmount previous WebDAV mount at " webdav-mount-point))))
     (loop [tries 1]
       (if-not (or (.exists output-dir) (.mkdirs output-dir))
         (throw (IOException. (str "Unable to create WebDAV mount point " webdav-mount-point))))
@@ -318,7 +319,7 @@
         (if (= 4 tries)
           (throw (IOException. (str "Unable to mount WebDAV at " webdav-endpoint)))
           (do
-            (unmount-if)
+            (umount-webdav webdav-mount-point)
             (Thread/sleep (* tries 500))
             (recur (inc tries))))))
     webdav-mount-point))
@@ -332,6 +333,13 @@
     (socket address port))
   ;; Start dedicated thread to read messages from socket
   (start-reading-messages repl-env opts))
+
+(defn tear-down
+  [repl-env]
+  (when-let [webdav-mount-point @(:webdav-mount-point repl-env)]
+    (umount-webdav webdav-mount-point))
+  (when-let [socket @(:socket repl-env)]
+    (close-socket socket)))

 (defn setup
   [repl-env opts]


(MAINT) whitespace changes on map

(MAINT) whitespace changes on map

This commit doesn't contain any code changes; just whitespace changes
for the formatting of a map literal, to make the subsequent commits
easier to review.

--- src/clj/puppetlabs/services/jruby/jruby_puppet_schemas.clj
+++ src/clj/puppetlabs/services/jruby/jruby_puppet_schemas.clj
@@ -80,21 +80,21 @@
   ;; the order of things that you put into a `both` to be very important.
   ;; The `vector?` pred here MUST come before the `[schema/Str]`.  For more info
   ;; see https://github.com/Prismatic/schema/issues/68
-  {:ruby-load-path              (schema/both (schema/pred vector?) [schema/Str])
-   :gem-home                    schema/Str
-   :master-conf-dir             (schema/maybe schema/Str)
-   :master-code-dir             (schema/maybe schema/Str)
-   :master-var-dir              (schema/maybe schema/Str)
-   :master-run-dir              (schema/maybe schema/Str)
-   :master-log-dir              (schema/maybe schema/Str)
-   :http-client-ssl-protocols   [schema/Str]
-   :http-client-cipher-suites   [schema/Str]
+  {:ruby-load-path (schema/both (schema/pred vector?) [schema/Str])
+   :gem-home schema/Str
+   :master-conf-dir (schema/maybe schema/Str)
+   :master-code-dir (schema/maybe schema/Str)
+   :master-var-dir (schema/maybe schema/Str)
+   :master-run-dir (schema/maybe schema/Str)
+   :master-log-dir (schema/maybe schema/Str)
+   :http-client-ssl-protocols [schema/Str]
+   :http-client-cipher-suites [schema/Str]
    :http-client-connect-timeout-milliseconds schema/Int
-   :http-client-idle-timeout-milliseconds    schema/Int
-   :borrow-timeout              schema/Int
-   :max-active-instances        schema/Int
-   :max-requests-per-instance   schema/Int
-   :use-legacy-auth-conf        schema/Bool})
+   :http-client-idle-timeout-milliseconds schema/Int
+   :borrow-timeout schema/Int
+   :max-active-instances schema/Int
+   :max-requests-per-instance schema/Int
+   :use-legacy-auth-conf schema/Bool})

 (def JRubyPoolAgent
   "An agent configured for use in managing JRuby pools"


(MAINT) Correct docstring

(MAINT) Correct docstring

--- src/clj/puppetlabs/services/jruby/jruby_puppet_service.clj
+++ src/clj/puppetlabs/services/jruby/jruby_puppet_service.clj
@@ -17,7 +17,7 @@

 (def default-http-connect-timeout
   "The default number of milliseconds that the client will wait for a connection
-  to be established. Currently set to 20 minutes."
+  to be established. Currently set to 2 minutes."
   (* 2 60 1000))

 (def default-http-socket-timeout


Use the task icon to mark a production as recorded

--- src/cljs/mdr2/productions/in_production.cljs
+++ src/cljs/mdr2/productions/in_production.cljs
@@ -256,7 +256,7 @@
          (tooltip-button
           {:on-click (fn [e] (rf/dispatch [::recorded-production uuid]))
            :tooltip :mark-recorded
-           :icon "check_circle"})))
+           :icon "task"})))
      ;; show the "Split" button if the next state is "split" and the user is
      ;; authorized
      (when (and (seq (set/intersection #{:it :admin} roles))


test for BigDecimal serialization

test for BigDecimal serialization

--- test/clj_json/core_test.clj
+++ test/clj_json/core_test.clj
@@ -61,3 +61,10 @@
       (is (= {"foo" {"bar" "empty"}}
              (json/parse-string
               (json/generate-string {"foo" {"bar" nil}})))))))
+
+
+(deftest test-bigdecimal
+  (is (= "{\"data1\":1,\"data2\":1.11}"
+          (json/generate-string {:data1 1M :data2 1.11M})))
+)
+


[inbox] Prevent new blank threads from jumping around

--- src/braid/core/client/ui/views/threads.cljs
+++ src/braid/core/client/ui/views/threads.cljs
@@ -25,21 +25,23 @@
                    ;; 'target threads' are the threads we want displayed (via latest props)
                    ;; 'target threads' likely overlap with 'existing threads'
                    ;; 'blank threads' are target threads that have no messages
-                   (let [blank-thread-ids (->> target-threads
-                                               (filter (fn [thread]
-                                                         (empty? (thread :messages))))
-                                               (map :id)
-                                               (set))
-                         existing-thread-ids (set (map :id existing-threads))
-                         target-thread-ids (difference (set (map :id target-threads))
-                                                       blank-thread-ids)
+                   (let [existing-thread-ids (set (map :id existing-threads))
+                         target-thread-ids (set (map :id target-threads))
+                         ;; possible to have multiple blank threads
+                         ;; want only the 'new' ones to appear at front, rest stay as they were
+                         new-blank-thread-ids (difference (->> target-threads
+                                                               (filter (fn [thread]
+                                                                         (empty? (thread :messages))))
+                                                               (map :id)
+                                                               (set))
+                                                          existing-thread-ids)
                          to-remove (difference existing-thread-ids target-thread-ids)
-                         to-add (difference target-thread-ids existing-thread-ids)
+                         to-add (difference target-thread-ids existing-thread-ids new-blank-thread-ids)
                          ;; here's the overall order:
                          ;;   blank threads (from target-threads)
                          ;;   existing threads (in their existing order) (minus any closed threads)
                          ;;   new threads (from target-threads)
-                         ordered-ids (concat blank-thread-ids
+                         ordered-ids (concat new-blank-thread-ids
                                              (remove to-remove existing-thread-ids)
                                              (filter to-add target-thread-ids))
                          target-threads-by-id (zipmap


Added some commentary about a =future=> fact.

--- test/midje/t_semi_sweet.clj
+++ test/midje/t_semi_sweet.clj
@@ -163,6 +163,11 @@
   (after-silently
    (expect (+ (mocked-function 12) (mocked-function 33)) => "result irrelevant because of earlier failure"
            (fake (mocked-function 12) => "hi"))
+   ;; At the moment, this does not produce a :mock-argument-match-failure. What it does
+   ;; is call the "unfinished" function, which blows up, producing a `bad-result` (the exception
+   ;; object). That's not horrible, especially at the semi-sweet level, but it does suggest
+   ;; that the implementation of the sweet behavior (where an unfinished function produces
+   ;; an argument-match failure) is fragile.
    @reported =future=> (just (contains {:type :mock-argument-match-failure :actual '(33)})
                       bad-result))


Update tools.namespace to v0.2.5

Update tools.namespace to v0.2.5

--- roles/clojure/files/profiles.clj
+++ roles/clojure/files/profiles.clj
@@ -3,7 +3,7 @@
         :dependencies [[alembic "0.2.1"]
                        [clj-stacktrace "0.2.7"]
                        [criterium "0.4.2"]
-                       [org.clojure/tools.namespace "0.2.4"]
+                       [org.clojure/tools.namespace "0.2.5"]
                        [slamhound "1.5.3"]
                        [spyscope "0.1.4"]]


Add clj-http

Add clj-http

--- roles/clojure/files/profiles.clj
+++ roles/clojure/files/profiles.clj
@@ -1,6 +1,7 @@
 {:user {:signing {:gpg-key "8ED1CE42"}

         :dependencies [[alembic "0.2.1"]
+                       [clj-http "1.0.1"]
                        [clj-stacktrace "0.2.7"]
                        [cljfmt "0.1.7"]
                        [criterium "0.4.2"]


Add counters.

Add counters.

--- src/dsbdp/local_data_processing_pipeline.clj
+++ src/dsbdp/local_data_processing_pipeline.clj
@@ -12,7 +12,7 @@
   dsbdp.local-data-processing-pipeline
   (:require [dsbdp.data-processing-dsl :refer :all])
   (:import
-    (dsbdp LocalTransferContainer ProcessingLoop)
+    (dsbdp Counter LocalTransferContainer ProcessingLoop)
     (java.util.concurrent ArrayBlockingQueue BlockingQueue LinkedBlockingQueue LinkedTransferQueue TransferQueue)))

@@ -28,7 +28,7 @@
 ;  `(ArrayBlockingQueue. *queue-size*))

 (defmacro enqueue
-  [^TransferQueue queue data]
+  [^TransferQueue queue data enqueued-counter dropped-counter]
 ;  [^BlockingQueue queue data]
 ;  `(.put ~queue ~data))
   `(.transfer ~queue ~data))
@@ -46,19 +46,22 @@
   ([^BlockingQueue in-queue f id]
     (let [running (atom true)
           out-queue (create-queue)
+          out-counter (Counter.)
+          out-drop-counter (Counter.)
           proc-fn (fn []
                     (try
                       (let [^LocalTransferContainer c (take-from-queue in-queue)
                             new-out (f (.getIn c) (.getOut c))]
                         (if (not (nil? new-out))
                           (.setOut c new-out))
-                        (enqueue out-queue c))
+                        (enqueue out-queue c out-counter out-drop-counter))
                       (catch InterruptedException e
                         (if @running
                           (throw e)))))
+          thread-id (str "ProcessingElement_" id)
           proc-loop (if (not (nil? id))
                       (ProcessingLoop.
-                        (str "ProcessingElement_" id)
+                        thread-id
                         proc-fn)
                       (ProcessingLoop.
                         proc-fn))]
@@ -66,7 +69,8 @@
       {:interrupt (fn []
                     (reset! running false)
                     (.interrupt proc-loop))
-       :out-queue out-queue})))
+       :out-queue out-queue
+       :thread-id thread-id})))

 (defn interrupt
   [proc-element]
@@ -98,7 +102,9 @@
                                 (out-fn nil nil)))
                             (catch InterruptedException e
                               (if @running
-                                (throw e))))))]
+                                (throw e))))))
+        in-counter (Counter.)
+        in-drop-counter (Counter.)]
     (.start out-proc-loop)
     {:interrupt (fn []
                   (reset! running false)
@@ -106,7 +112,7 @@
                     (interrupt pe))
                   (.interrupt out-proc-loop))
      :in-fn (fn [in]
-              (enqueue in-queue (LocalTransferContainer. in nil)))}))
+              (enqueue in-queue (LocalTransferContainer. in nil) in-counter in-drop-counter))}))

 (defn get-in-fn
   [pipeline]


Add support for sentiment analysis from file.

--- src/lexemic/core.cljs
+++ src/lexemic/core.cljs
@@ -1,22 +1,28 @@
 (ns lexemic.core
-  (:require [lexemic.sentiment.simple :as sentiment]))
+  (:require [cljs.nodejs :as node]
+            [lexemic.sentiment.simple :as sentiment]))
+
+(def ^:private fs
+  (node/require "fs"))

 (def ^:private usage-banner "Usage: lexemic [command] [target]")
 (def ^:private supported-commands #{"help" "sentiment"})

-(defn- show-help []
-  (do
-    (println usage-banner)))
+(defn- help []
+  (str usage-banner))

 (defn- run [cmd text]
   (condp = cmd
-    "sentiment" (println (sentiment/analyse text))))
+    "sentiment" (sentiment/analyse text)))

 (defn -main [& args]
   (let [command (first args)
-        input (second args)]
+        target (second args)
+        input (if (.existsSync fs target)
+                (.readFileSync fs target "utf8")
+                target)]
     (if-let [cmd (supported-commands command)]
-      (run cmd input)
-      (show-help))))
+      (println (run cmd input))
+      (println (help)))))

 (set! *main-cli-fn* -main)


Rename top to root

Rename top to root

--- src/javascript_externs_generator/extern.cljs
+++ src/javascript_externs_generator/extern.cljs
@@ -56,7 +56,7 @@
       :else
       (let [props-extern (str "{" (string/join "," (for [p props]
                                                      (build-props-extern p))) "}")]
-        (if (get obj :top)
+        (if (get obj :root)
           (str "var " name " = " props-extern ";")
           (str (quote-string name) ": " props-extern))))))

@@ -80,7 +80,7 @@
   "Recursively extract properties and prototypes from a JavaScript object
   into an extern for use with the Google Closure Compiler"
   [name js-object]
-  (let [tree (assoc (build-tree js-object name) :top true)
+  (let [tree (assoc (build-tree js-object name) :root true)
         props-extern (build-props-extern tree)
         prototype-extern (build-prototype-extern tree name)]
     (str props-extern prototype-extern)))


updated to allow resource files as well as folders

--- src/leiningen/new/cryogen/src/cryogen/io.clj
+++ src/leiningen/new/cryogen/src/cryogen/io.clj
@@ -25,8 +25,14 @@
   (doseq [path (.listFiles (file public))]
     (fs/delete-dir path)))

-(defn copy-resources [{:keys [blog-prefix resources]}]
+(defn copy-resources [{:keys [blog-prefix resources]}]
   (doseq [resource resources]
-    (fs/copy-dir
-      (str "resources/templates/" resource)
-      (str public blog-prefix "/" resource))))
+    (let [src (str "resources/templates/" resource)
+          target (str public blog-prefix "/" resource)]
+      (cond
+        (not (.exists (file src)))
+        (throw (IllegalArgumentException. (str "resource " src " not found")))
+        (.isDirectory (file src))
+        (fs/copy-dir src target)
+        :else
+        (fs/copy src target)))))


Mention (game :x) and (game :y) in defscreen docstring

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -172,7 +172,8 @@
         entities))

     ; input functions
-    ; Tip: convert :input-x and :input-y to screen coordinates with input->screen
+    ; Tip: convert :input-x and :input-y to screen coordinates with input->screen,
+    ; or just use (game :x) and (game :y) instead
     (defscreen my-screen
       ; a key was pressed
       :on-key-down


Remove default geometry columns

Remove default geometry columns

--- src/main/clojure/pdok/featured/geoserver.clj
+++ src/main/clojure/pdok/featured/geoserver.clj
@@ -34,20 +34,13 @@

 (defn- gs-create-collection [{:keys [db dataset]} ndims srid collection]
   "Create table with default fields"
-  (let [table collection
-        geometries [:_geometry_point :_geometry_line :_geometry_polygon]]
-
+  (let [table collection]
     (pg/create-table db dataset table
                      [:gid "serial" :primary :key]
                      [:_id "text"]
                      [:_parent_id "text"]
-                     [:_version "uuid"]
-                     [:_geo_group "text"])
-
-    (pg/create-index db dataset table "_id")
-    (doseq [geometry geometries]
-      (#(pg/create-column db dataset table %1 pg/geometry-type ndims srid) geometry)
-      ((partial pg/create-geo-index db dataset table) geometry))))
+                     [:_version "uuid"])
+    (pg/create-index db dataset table "_id")))

 (defn- gs-collection-attributes [{:keys [db dataset]} collection]
   (let [table collection
@@ -55,11 +48,7 @@
         no-defaults (filter #(not (some #{(:column_name %)} ["gid"
                                                              "_id"
                                                              "_parent_id"
-                                                             "_version"
-                                                             "_geometry_point"
-                                                             "_geometry_line"
-                                                             "_geometry_polygon"
-                                                             "_geo_group"])) columns)
+                                                             "_version"])) columns)
         attributes (reduce (fn [acc c] (conj acc c)) #{} (map #(:column_name %) no-defaults))]
     attributes))

@@ -67,46 +56,25 @@
   (pg/create-column db dataset collection attribute-name (pg/clj-to-pg-type attribute-value) ndims srid))

 (defn- feature-to-sparse-record [proj-fn feature all-fields-constructor import-nil-geometry?]
-  ;; could use a valid-geometry? check?! For now not, as-jts return nil if invalid (for gml)
   (let [id (:id feature)
         parent-id (:parent-id feature)
         version (:version feature)
         sparse-attributes (all-fields-constructor (:attributes feature))]
-    (let [geometry-attribute (-> feature :geometry)
-          geometry (proj-fn (f/as-jts geometry-attribute))]
-      (when (or geometry import-nil-geometry?)
-        (let [geo-group (f/geometry-group geometry-attribute)
-              record (concat [id
-                              parent-id
-                              version
-                              (when (= :point geo-group) geometry)
-                              (when (= :line geo-group) geometry)
-                              (when (= :polygon geo-group) geometry)
-                              geo-group]
-                             sparse-attributes
-                             [id])]
-          record)))))
+    (concat [id
+                parent-id
+                version]
+               sparse-attributes
+               [id])))

 (defn- feature-keys [feature]
-  (let [geometry (-> feature :geometry)
-        attributes (:attributes feature)]
+  (let [attributes (:attributes feature)]
      (cond-> (transient [])
-             (and geometry (f/valid-geometry? geometry))
-             (conj!-coll [:_geometry_point :_geometry_line :_geometry_polygon :_geo_group])
              (seq attributes) (conj!-coll (keys attributes))
              true (persistent!))))

  (defn- feature-to-update-record [proj-fn feature]
-   (let [attributes (:attributes feature)
-         geometry (-> feature :geometry)
-         geo-group (when geometry (f/geometry-group geometry))]
+   (let [attributes (:attributes feature)]
      (cond-> (transient [(:version feature)])
-             (and geometry (f/valid-geometry? geometry))
-             (conj!-coll
-               [(when (= :point geo-group) (proj-fn (f/as-jts geometry)))
-                (when (= :line geo-group) (proj-fn (f/as-jts geometry)))
-                (when (= :polygon geo-group) (proj-fn (f/as-jts geometry)))
-                geo-group])
              (seq attributes) (conj!-coll (vals attributes))
              true (conj! (:id feature))
              true (conj! (:current-version feature))
@@ -114,9 +82,6 @@

 (defn- all-fields-constructor [attributes]
   (if (empty? attributes) (constantly nil) (apply juxt (map #(fn [col] (get col %)) attributes))))
-
-(defn- geo-column [geo-group]
-   (str "_geometry_" (name geo-group)))

 (defn gs-insert-sql [schema table columns]
   (str "INSERT INTO " (pg/quoted schema) "." (pg/quoted table)
@@ -136,7 +101,7 @@
                                (map #(feature-to-sparse-record proj-fn % (all-fields-constructor all-attributes) import-nil-geometry?)
                                     grouped-features))]
            (if (not (empty? records))
-             (let [fields (concat [:_id :_parent_id :_version :_geometry_point :_geometry_line :_geometry_polygon :_geo_group]
+             (let [fields (concat [:_id :_parent_id :_version]
                                   all-attributes)
                    sql (gs-insert-sql dataset collection fields)]
                (j/execute! db (cons sql records) :multi? true :transaction? (:transaction? db)))))))


Don't run scratch fns when compiling cljs

--- src/scratch.clj
+++ src/scratch.clj
@@ -1,5 +1,6 @@
 (ns scratch)

+(comment
 (def cmds
   (->> (slurp "resources/queriac-cmds.txt")
        (clojure.string/split-lines)
@@ -9,7 +10,7 @@
 (->> cmds
      (filter #(.contains (second %) "(q)"))
      (remove #(.contains (second %) "javascript:"))
-     (map #(zipmap [:name :url :alias] %))
+     (map #(zipmap [:name :url :alias] %))
      (map #(update-in % [:url]
                       (fn [x]
                         (clojure.string/replace-first x "(q)" "%s"))))
@@ -24,3 +25,4 @@
 ;; | incorrectly parsed
 (->> cmds
      (filter #(> (count %) 3)))
+ )


cleanup

cleanup

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -184,7 +184,6 @@
            (unify common
                   {:synsem {:sem {:pred :be}
                             :subcat {:2 {:cat :prep}}}})])
-

    "be able to" {:english {:imperfect {:1sing "was able to"
                                        :2sing "were able to"
@@ -2208,9 +2207,9 @@
                               :sem {:obj obj-sem}}}))

                  (default
-                  (let [location (atom :top)]
-                    {:synsem {:cat :verb
-                              :subcat {:2 {:subcat '()}}}}))
+                  {:synsem {:cat :verb
+                            :subcat {:2 {:subcat '()}}}})
+
                  (default
                   (let [location (atom :top)]
                     {:synsem {:cat :verb


cleanup babel.italiano.pos :refers

cleanup babel.italiano.pos :refers

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -1,25 +1,7 @@
 (ns babel.italiano.lexicon
   (:require
    [babel.lexiconfn :refer (unify)]
-   [babel.italiano.pos :refer (adjective
-                               agreement-noun
-                               cat-of-pronoun
-                               common-noun
-                               comparative
-                               countable-noun
-                               determiner
-                               drinkable-noun
-                               feminine-noun
-                               intransitive
-                               intransitive-unspecified-obj
-                               masculine-noun
-                               non-comparative-adjective
-                               noun
-                               pronoun-acc
-                               sentential-adverb
-                               transitive verb-subjective
-                               verb-aux)]
-   ))
+   [babel.italiano.pos :refer :all]))

 (def lexicon-source
   {"Antonia"


(maint) :refer :all makes unicorns cry

(maint) :refer :all makes unicorns cry

--- test/puppetlabs/trapperkeeper/services/authorization/authorization_service_test.clj
+++ test/puppetlabs/trapperkeeper/services/authorization/authorization_service_test.clj
@@ -5,7 +5,7 @@
     [puppetlabs.ssl-utils.core :as ssl-utils]
     [puppetlabs.trapperkeeper.app :refer [get-service]]
     [puppetlabs.trapperkeeper.authorization.rules :as rules]
-    [puppetlabs.trapperkeeper.authorization.testutils :as testutils :refer :all]
+    [puppetlabs.trapperkeeper.authorization.testutils :as testutils]
     [puppetlabs.trapperkeeper.services :refer [defservice]]
     [puppetlabs.trapperkeeper.services.authorization.authorization-service
      :refer [authorization-service]]
@@ -120,11 +120,11 @@

 (def base-request
   "A basic request to feed into the tests"
-  (request "/" :get "127.0.0.1" (create-certificate "test.domain.org") ))
+  (testutils/request "/" :get "127.0.0.1" (testutils/create-certificate "test.domain.org") ))

 (def unauthenticated-request
   "A basic unauthenticated request to feed into the tests"
-  (request "/" :get "127.0.0.1"))
+  (testutils/request "/" :get "127.0.0.1"))

 (defprotocol EchoReverseService
   (echo-reverse [this msg]))
@@ -217,7 +217,7 @@
         (is (= status 403) "Unauthentic requests are denied with allow-unauthenticated false"))))
   (testing "With a minimal config of an empty list of rules"
     (let [app (build-ring-handler [])
-          req (request "/path/to/foo" :get "127.0.0.1" test-domain-cert)
+          req (testutils/request "/path/to/foo" :get "127.0.0.1" testutils/test-domain-cert)
           {:keys [status body]} (app req)]
       (is (= status 403))
       (is (= body "global deny all - no rules matched"))))
@@ -232,17 +232,17 @@
                        "denied by rule 'puppetlabs catalog'.")))))
   (testing "Evaluation against rule with 'method' restrictions"
     (let [app (build-ring-handler default-rules)]
-      (let [req (request "/puppet-ca/v1/certificate_request/ca"
-                         :head "127.0.0.1" test-domain-cert)
+      (let [req (testutils/request "/puppet-ca/v1/certificate_request/ca"
+                         :head "127.0.0.1" testutils/test-domain-cert)
             {:keys [status body]} (app req)]
         (is (= status 403))
         (is (= body "global deny all - no rules matched")))
-      (let [req (request "/puppet-ca/v1/certificate_request/ca"
-                         :get "127.0.0.1" test-domain-cert)
+      (let [req (testutils/request "/puppet-ca/v1/certificate_request/ca"
+                         :get "127.0.0.1" testutils/test-domain-cert)
             {:keys [status]} (app req)]
         (is (= status 200)))
-      (let [req (request "/puppet-ca/v1/certificate_request/ca"
-                         :put "127.0.0.1" test-domain-cert)
+      (let [req (testutils/request "/puppet-ca/v1/certificate_request/ca"
+                         :put "127.0.0.1" testutils/test-domain-cert)
             {:keys [status]} (app req)]
         (is (= status 200))))))

@@ -269,8 +269,8 @@
                   (update-in [:headers] merge
                              {"x-client-dn" "CN=test.domain.org"
                               "x-client-verify" "SUCCESS"
-                              "x-client-cert" (url-encoded-cert
-                                                test-domain-cert)}))
+                              "x-client-cert" (testutils/url-encoded-cert
+                                                testutils/test-domain-cert)}))
           response (app req)
           authorization (get-in response [:request :authorization])]
       (is (= 200 (:status response)))
@@ -433,12 +433,12 @@
           [plumbing-service authorization-service]
           (assoc-in minimal-config [:authorization :rules] rules-w-exts)
           (testing "allowed request via extensions"
-            (let [req (request "/puppet/v4/catalog" :get "127.0.0.1" allowable-cert)]
+            (let [req (testutils/request "/puppet/v4/catalog" :get "127.0.0.1" allowable-cert)]
               (is (-> (get-service app :PlumbingService)
                       (call-authorization-check req {:oid-map oid-map})
                       rules/authorized?))))
           (testing "denied request via extensions"
-            (let [req (request "/puppet/v4/catalog" :get "127.0.0.1" deniable-cert)]
+            (let [req (testutils/request "/puppet/v4/catalog" :get "127.0.0.1" deniable-cert)]
               (is (not (-> (get-service app :PlumbingService)
                            (call-authorization-check req {:oid-map oid-map})
                            rules/authorized?)))))


removed use-cache-or-update

removed use-cache-or-update

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -77,28 +77,9 @@
     (when-let [e @error]
       (throw e))))

-(defn use-cache-or-update
-  [domain remote-path edb-config state]
-  (let [{:keys [hdfs-conf local-dir local-db-conf]} edb-config
-        fs  (filesystem hdfs-conf)
-        lfs (local-filesystem)
-        local-domain-root (str (path local-dir domain))
-        remote-vs (DomainStore. fs remote-path)
-        local-vs  (DomainStore. lfs local-domain-root (.getSpec remote-vs))]
-    (if (domain-needs-update? local-vs remote-vs)
-      (load-domain domain
-                   fs
-                   local-db-conf
-                   local-domain-root
-                   remote-path
-                   state)
-      (with-ret nil
-        (let [{:keys [finished-loaders shard-states]} state]
-          (swap! finished-loaders + (count (shard-states domain))))))))
-
 (defn load-and-sync-status!
   "TODO: Only note success for non-failed domains. check thrift status."
-  [edb-config rw-lock domains-info & {:keys [state]}]
+  [edb-config rw-lock domains-info loader-state]
   (let [{:keys [hdfs-conf local-dir local-db-conf]} edb-config
         remote-fs (filesystem hdfs-conf)
         remote-path-map (:domains edb-config)
@@ -109,14 +90,17 @@
                               (let [remote-path (get remote-path-map domain)
                                     remote-vs (DomainStore. remote-fs remote-path)
                                     local-domain-root (str (path local-dir domain))
-                                    local-vs (mk-local-vs remote-vs local-domain-root)
-                                    loader-state (or state (mk-loader-state
-                                                            {domain (domain/host-shards info)}))]
-                                (when-let [new-data (use-cache-or-update domain
-                                                                         remote-path
-                                                                         edb-config
-                                                                         loader-state)]
-                                  (domain/set-domain-data! rw-lock domain info new-data)))
+                                    local-vs (mk-local-vs remote-vs local-domain-root)]
+                                (if (domain-needs-update? local-vs remote-vs)
+                                  (->> (load-domain domain
+                                                    remote-fs
+                                                    local-db-conf
+                                                    local-domain-root
+                                                    remote-path
+                                                    loader-state)
+                                       (domain/set-domain-data! rw-lock domain info))
+                                  (let [{:keys [finished-loaders shard-states]} loader-state]
+                                    (swap! finished-loaders + (count (shard-states domain))))))
                               (domain/set-domain-status! info (thrift/ready-status))
                               (catch Throwable t
                                 (log-error t "Error when loading domain " domain)
@@ -179,7 +163,8 @@
       (future
         (try (purge-unused-domains! domain-seq local-dir)
              (load-cached-domains! edb-config rw-lock domains-info)
-             (load-and-sync-status! edb-config rw-lock domains-info)
+             (load-and-sync-status! edb-config rw-lock domains-info (map-mapvals domains-info
+                                                                                domain/host-shards))
              (log-message "Finished loading all updated domains from remote.")
              (catch Throwable t
                (log-error t "Error when syncing data.")


Count total requests made by so far and use that for checking whether we should continue

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -51,7 +51,7 @@
         (recur (rest r) new-ctx (conj results result))))))

 (defprotocol RunnerProtocol
-  (continue-run? [runner response-count scenario-start])
+  (continue-run? [runner handled-requests scenario-start])
   (runner-info [runner]))

 (deftype DurationRunner [scenario]
@@ -63,8 +63,8 @@

 (deftype FixedRequestNumberRunner [scenario]
   RunnerProtocol
-  (continue-run? [runner response-count _]
-    (< (* (count (:requests scenario)) response-count) (:number-of-requests scenario)))
+  (continue-run? [runner handled-requests _]
+    (< handled-requests (:number-of-requests scenario)))
   (runner-info [_] (str "requests " (:number-of-requests scenario))))

 (defn- request-result [id request-name success start]
@@ -99,9 +99,11 @@
   (let [scenario-start (local-time/local-now)
         response-chan (async/merge (map #(run-scenario-constantly scenario timeout %)
                                         (range (:concurrency scenario))))]
-    (loop [responses []]
-      (if (continue-run? (:runner scenario) (count responses) scenario-start)
-        (recur (conj responses (response->result scenario (<!! response-chan))))
+    (loop [responses []
+           handled-requests 0]
+      (if (continue-run? (:runner scenario) handled-requests scenario-start)
+        (let [result (response->result scenario (<!! response-chan))]
+          (recur (conj responses result) (+ handled-requests (count (:requests result)))))
         responses))))

 (defn- print-scenario-info [scenario]


kill dead line

kill dead line

--- src/clojure/confgraph/core.clj
+++ src/clojure/confgraph/core.clj
@@ -11,7 +11,6 @@
 (def defs     (for [x (.listFiles (File. "defs/runs")) :when (.isFile x)] x))
 (def vertices (for [x defs] (.getName x)))
 (def edges    (zipmap vertices (for [x defs] (extends x))))
-;;(def edges    (filter #(val %) (zipmap vertices (for [x defs] (extends x)))))

 (def rootpath
   (memoize (fn [src]


Documentation fix

Documentation fix

--- src/clojure/neko/ui/traits.clj
+++ src/clojure/neko/ui/traits.clj
@@ -53,17 +53,19 @@
   "Defines a trait with the given name.

   `match-pred` is a function on attributes map that should return a
-  logical truth if this trait should be executed against the argument
-  list. By default it checks if attribute with the same name as
+  logical truth if this trait should be executed against the widget
+  and the map. By default it checks if attribute with the same name as
   trait's is present in the attribute map.

-  `codegen-fn` is a function that should take the same arguments as
-  `transform-attributes` and return either the generated code directly
-  or a map with the following keys: `:code`, `:attribute-fn`,
-  `:options-fn`. In the former case `attribute-fn` defaults to
-  dissoc'ing trait's name from attribute map, and `options-fn`
-  defaults to identity function."
-  ^{:arglists '([name docstring? match-pred? codegen-fn])}
+  The parameter list is the following: `[widget attributes-map
+  options-map]`.
+
+  Body of the trait can optionally return a map with the following
+  keys: `:attribute-fn`, `:options-fn`, which values are functions to
+  be applied to attributes map and options map respectively after the
+  trait finishes its work. If they are not provided, `attribute-fn`
+  defaults to dissoc'ing trait's name from attribute map, and
+  `options-fn` defaults to identity function."
   [name & args]
   (let [[docstring args] (if (string? (first args))
                            [(first args) (next args)]
@@ -86,6 +88,9 @@
                [~dissoc-fn identity]))
            [identity identity])))))

+(alter-meta! #'deftrait
+             assoc :arglists '([name docstring? match-pred? [params*] body]))
+
 ;; ## Implementation of different traits

 ;; ### Def attribute


use logo_splash.png as application window icon

--- src/clojure/nightcode/core.clj
+++ src/clojure/nightcode/core.clj
@@ -44,6 +44,7 @@
                  :content (create-window-content)
                  :width 1242
                  :height 768
+                 :icon "logo_splash.png"
                  :on-close :nothing)
     ; listen for keys while modifier is down
     (shortcuts/listen-for-shortcuts!


(PDB-3732) fix bigint types in engine

(PDB-3732) fix bigint types in engine

--- src/puppetlabs/puppetdb/query_eng/engine.clj
+++ src/puppetlabs/puppetdb/query_eng/engine.clj
@@ -859,7 +859,7 @@
                              "latest_report?" {:type :boolean
                                                :queryable? true
                                                :query-only? true}
-                             "report_id" {:type :bigint
+                             "report_id" {:type :numeric
                                           :queryable? false
                                           :query-only? true
                                           :field :events.report_id}}
@@ -906,7 +906,7 @@

 (def latest-report-id-query
   "Usually used as a subquery of reports"
-  (map->Query {:projections {"latest_report_id" {:type :bigint
+  (map->Query {:projections {"latest_report_id" {:type :numeric
                                                  :queryable? true
                                                  :field :certnames.latest_report_id}}
                :selection {:from [:certnames]}


return a map not a list

return a map not a list

--- src/crawler/rich_extractor.clj
+++ src/crawler/rich_extractor.clj
@@ -11,7 +11,7 @@
 ;;;; some statistics.

 (defn featurize
-  [xpath nodes]
+  [nodes]
   (map
    (fn [{_ :node href :href text :text}]
      (let [url-tokens  (set (utils/tokenize-url href))
@@ -37,10 +37,11 @@
                                              (nil? (uri/host (:href a-node)))))
                                        nodes)])
                              xpaths-hrefs-text)))]
-    (map
-     (fn [[xpath nodes]]
-       (featurize xpath nodes))
-     in-host-xhrefs)))
+    (into
+     {} (map
+         (fn [[xpath nodes]]
+           [xpath (featurize nodes)])
+         in-host-xhrefs))))

 (defn follow-naive?
   "Decide if an Xpath's links are worth following based on a naive score of richness.


Enabling thrift tests.

Enabling thrift tests.

--- test/clojurewerkz/cassaforte/test_helper.clj
+++ test/clojurewerkz/cassaforte/test_helper.clj
@@ -21,9 +21,3 @@
     (with-native-exception-handling
       (cql-schema/set-keyspace "cassaforte_test_1")))
   (f))
-
-;;
-;; TBD
-;;
-(defn initialize-thrift
-  [f])


sample-submit-job was not rendered in the lein project

--- src/leiningen/new/onyx_app.clj
+++ src/leiningen/new/onyx_app.clj
@@ -37,6 +37,7 @@
                 [(str "src/" path "/catalogs/sample_catalog.clj") (render "sample_catalog.clj" data)]
                 [(str "src/" path "/flow_conditions/sample_flow_conditions.clj") (render "sample_flow_conditions.clj" data)]
                 [(str "src/" path "/functions/sample_functions.clj") (render "sample_functions.clj" data)]
+                [(str "src/" path "/jobs/sample_submit_job.clj") (render "sample_submit_job.clj" data)]
                 [(str "src/" path "/lifecycles/sample_lifecycle.clj") (render "sample_lifecycle.clj" data)]
                 [(str "src/" path "/plugins/http_reader.clj") (render "http_reader.clj" data)]


fix typo

fix typo

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@10567 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -150,9 +150,9 @@
        "XPositionUm" x
        "YPositionUm" y
        "ZPositionUm" (get-in state [:last-stage-positions (state :default-z-drive)])
-      }
-      (when-let [runnables (event :runnables)]
-        {"AttachedTasks" (JSONArray. (map str runnables))}))))
+      })
+    (when-let [runnables (event :runnables)]
+      {"AttachedTasks" (JSONArray. (map str runnables))})))

 (defn annotate-image [img event state elapsed-time-ms]
   {:pix (:pix img)


always start the telemetry, but use a nil riemann-client if none is configured

This makes it easier to just start the component everytime, even when unconfigured, and use its API.

--- core/src/gorillalabs/tesla/component/telemetry.clj
+++ core/src/gorillalabs/tesla/component/telemetry.clj
@@ -31,7 +31,7 @@

 (defn- flush-queue [client queue]
   (let [events (drain-queue queue)]
-    (when (seq events)
+    (when (and client (seq events))
       (log/infof "Sending %d event(s) to telemetry backend..." (count events))
       (riemann/send-events client events))))

@@ -75,17 +75,17 @@
                     (recur))))))

 (defn- start []
-  (when-let [config (config/config config/configuration [:telemetry])]
-    (log/info "-> starting telemetry")
-    (let [queue     (chan (sliding-buffer 100))
-          killswitch (chan)
-          client    (riemann/tcp-client (:riemann config))]
-      (worker killswitch client queue (:interval config 30))
-      {:host      (:host config (localhost))
-       :r-client  client
-       :queue     queue
-       :config    config
-       :killswitch killswitch})))
+  (log/info "-> starting telemetry")
+  (let [config     (config/config config/configuration [:telemetry])
+        queue      (chan (sliding-buffer 100))
+        killswitch (chan)
+        client     (when (:riemann config) (riemann/tcp-client (:riemann config)))]
+    (worker killswitch client queue (:interval config 30))
+    {:host       (:host config (localhost))
+     :r-client   client
+     :queue      queue
+     :config     config
+     :killswitch killswitch}))

 (defn- stop [telemetry]
   (log/info "<- stopping telemetry")


CMR-1885 Update parse-projects to use parse-short-name-long-name

--- umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/serf.clj
+++ umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/serf.clj
@@ -41,9 +41,7 @@
 (defn- parse-projects
   "Parses the Project elements of a SERF record and creates a UMM-S representation"
   [doc]
-  (for [proj (select doc "/SERF/Project")]
-    {:ShortName (value-of proj "Short_Name")
-     :LongName (value-of proj "Long_Name")}))
+  (parse-short-name-long-name doc "/SERF/Project"))

 (defn- parse-data-dates
   "Returns seq of UMM-CMN DataDates parsed from SERF document."


fix overlap in 24h chart (workaround)

fix overlap in 24h chart (workaround)

--- src/cljs/iwaswhere_web/ui/charts/time/twenty_four_hour.cljs
+++ src/cljs/iwaswhere_web/ui/charts/time/twenty_four_hour.cljs
@@ -25,25 +25,50 @@
             mouse-enter-fn (cc/mouse-enter-fn local day-stats)
             mouse-leave-fn (cc/mouse-leave-fn local day-stats)
             stories @stories
+            midnight (* 26 60 60 y-scale)
+            midnight-s (* 2 60 60 y-scale)
             time-by-ts (:time-by-ts day-stats)
             time-by-h (map (fn [[ts v]]
                              (let [h (/ (- ts day) 1000 60 60)]
                                [h v])) time-by-ts)]
-        [:g
-         {:on-mouse-enter mouse-enter-fn
-          :on-mouse-leave mouse-leave-fn}
+        [:g {:on-mouse-enter mouse-enter-fn
+             :on-mouse-leave mouse-leave-fn}
          (for [[hh {:keys [summed manual] :as data}] time-by-h]
-           (let [h (* y-scale summed)
+           (let [item-name (item-name-k data)
+                 h (* y-scale summed)
                  y (* y-scale (+ hh 2) 60 60)
-                 item-name (item-name-k data)
                  y (if (pos? manual) (- y h) y)]
              ^{:key (str item-name hh)}
-             [:rect {:fill           (cc/item-color item-name)
-                     :on-mouse-enter #(prn item-name hh summed)
-                     :x              (+ 20 (* 13 idx))
-                     :y              y
-                     :width          11
-                     :height         h}]))]))))
+             [:g
+              (let [h (min h (- midnight y))
+                    h (if (< y midnight-s)
+                        (- h (- midnight-s y))
+                        h)
+                    y (max midnight-s y)]
+                [:rect {:fill           (cc/item-color item-name)
+                        :on-mouse-enter #(prn item-name hh summed)
+                        :x              (+ 20 (* 13 idx))
+                        :y              y
+                        :width          11
+                        :height         h}])
+              (when (> (+ y h) midnight)
+                (let [h (- (+ y h) midnight)
+                      y midnight-s]
+                  [:rect {:fill           (cc/item-color item-name)
+                          :on-mouse-enter #(prn item-name hh summed)
+                          :x              (+ 20 (* 13 (inc idx)))
+                          :y              y
+                          :width          11
+                          :height         h}]))
+              (when (< y midnight-s)
+                (let [h (- midnight-s y)
+                      y (- midnight h)]
+                  [:rect {:fill           (cc/item-color item-name)
+                          :on-mouse-enter #(prn item-name hh summed)
+                          :x              (+ 20 (* 13 (dec idx)))
+                          :y              y
+                          :width          11
+                          :height         h}]))]))]))))

 (defn legend
   [text x y]
@@ -60,11 +85,12 @@
   [indexed local item-name-k chart-h y-scale put-fn]
   [:svg.earlybird
    {:shape-rendering "crispEdges"
-    :style {:height chart-h}}
+    :style           {:height chart-h}}
    [:g
     (for [h (range 28)]
       (let [y (* chart-h (/ h 28))
-            stroke-w (if (zero? (mod (- h 2) 6)) 1 0.5)]
+            stroke-w (if (zero? (mod (- h 2) 6)) 1 0.5)
+            stroke-w (if (or (< h 2) (> h 26)) 0 stroke-w)]
         ^{:key h}
         [:line {:x1           17
                 :x2           202


change tables to divs

change tables to divs

--- src/mvMusic/view_templates.clj
+++ src/mvMusic/view_templates.clj
@@ -20,24 +20,20 @@
   [path]
   (->> (directory-url-list path)
        (map #(wrap-tag (first %1) :a {:href (second %1)}))
-       (map #(wrap-tag %1 :td))
-       (map #(wrap-tag %1 :tr))))
+       (map #(wrap-tag %1 :div))))

 (defn format-files
   "format files into table rows"
   [path]
   (->> (file-url-list path)
        (map #(wrap-tag (first %1) :a {:href (second %1)}))
-       (map #(wrap-tag %1 :td))
-       (map #(wrap-tag %1 :tr))))
+       (map #(wrap-tag %1 :div))))

 (defn body
   "Generate body html"
   [path]
   [:body
    [:h1 "mvMusic"]
-   (vec (concat [:table {:border 1}]
+   (vec (concat [:div]
           (format-directories path)
            (format-files path)))])
-
-


don't use shutter when autoshutter is off

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@7450 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -145,15 +145,15 @@
 (defn snap-image [open-before close-after]
   (with-core-setting [getAutoShutter setAutoShutter false]
     (let [shutter (core getShutterDevice)]
-      (device-best-effort shutter
-        (when open-before
+      (when open-before
+        (device-best-effort shutter
           (core setShutterOpen true)
           (wait-for-device (core getShutterDevice))))
       (device-best-effort (core getCameraDevice)
         (core snapImage))
       (swap! state assoc :last-image-time (elapsed-time @state))
-      (device-best-effort shutter
-        (when close-after
+      (when close-after
+        (device-best-effort shutter
           (core setShutterOpen false))
           (wait-for-device (core getShutterDevice))))))

@@ -265,10 +265,14 @@
 ;; higher level

 (defn expose [event]
-  (do (condp = (:task event)
-    :snap (snap-image true (:close-shutter event))
-    :init-burst (init-burst (:burst-length event) (:trigger-sequence event))
-    nil)))
+  (let [shutter-states
+         (if (core getAutoShutter)
+           [true (:close-shutter event)]
+           [false false])]
+    (condp = (:task event)
+      :snap (apply snap-image shutter-states)
+      :init-burst (init-burst (:burst-length event) (:trigger-sequence event))
+      nil)))

 (defn collect-image [event out-queue]
   (let [image (condp = (:task event)


select relevant cljs.edn files w/ by-path

--- src/adzerk/boot_reload.clj
+++ src/adzerk/boot_reload.clj
@@ -68,7 +68,7 @@
 (defn relevant-cljs-edn [prev fileset ids]
   (let [relevant  (map #(str % ".cljs.edn") ids)
         f         (if ids
-                    #(b/by-name relevant %)
+                    #(b/by-path relevant %)
                     #(b/by-ext [".cljs.edn"] %))]
     (-> (b/fileset-diff prev fileset) b/input-files f)))


Fix gobo name

Fix gobo name

Now that kabel-snake-kebab is being smarter about formatting keywords,
the cue needed fixing.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -292,7 +292,7 @@
                                                                :short-name (name-torrent-gobo-cue prefix function))))))
                          ["gobo-moving-rings" "gobo-moving-color-swirl" "gobo-moving-stars"
                           "gobo-moving-optical-tube" "gobo-moving-magenta-bundt"
-                          "gobo-moving-blue-megahazard" "gobo-moving-turbine"])]))
+                          "gobo-moving-blue-mega-hazard" "gobo-moving-turbine"])]))

 (defn make-strobe-cue
   "Create a cue which strobes a set of fixtures as long as the cue pad
@@ -450,7 +450,13 @@
                                                             :effect-name "Snowball Dimmers"))
                            :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
                            :color :orange :end-keys [:dimmers]))
-
+    (ct/set-cue! (:cue-grid *show*) 7 2
+                 (cues/cue :torrent-1-dimmer (fn [var-map] (dimmer-effect
+                                                            (params/bind-keyword-param (:level var-map 255) Number 255)
+                                                            (show/fixtures-named "torrent-1")
+                                                            :effect-name "Torrent 1 Dimmer"))
+                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
+                           :color :orange :end-keys [:dimmers :torrent-dimmers]))

     ;; Dimmer oscillator cues: Sawtooth down each beat
     (ct/set-cue! (:cue-grid *show*) 0 3


CMR-2112 Script PR fixes

CMR-2112 Script PR fixes

--- system-int-test/test/cmr/system_int_test/ingest/ops_collections_translation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/ops_collections_translation_test.clj
@@ -187,25 +187,23 @@
            (concat
             [(:_errors collection)]
             (for [key (keys collection)
-                  :let [coll (get collection key)]]
-              (cond
-                (map? coll) (extract-errors-from-collection coll)
-                (coll? coll) (for [entry coll]
-                               (when (map? entry)
-                                 (extract-errors-from-collection entry)))))))))
-
-(defn- reformat-error-messages
-  "For each 'string too long' error, just print out what string it is and the size so that
+                  :let [coll (get collection key)]
+                  result (cond
+                           (map? coll) (extract-errors-from-collection coll)
+                           (coll? coll) (for [entry coll
+                                              :when (map? entry)]
+                                          (extract-errors-from-collection entry)))]
+               result)))))
+
+(defn- reformat-error-message
+  "For a 'string too long' error, just print out what string it is and the size so that
   the test output does not get bloated with the full string"
-  [errors]
-  (map
-   (fn [error]
-     (if-let [result (re-find #"\w+ string .*is too long \(length: \d+, maximum allowed: \d+\)" (str/replace error "\n" ""))]
-       (let [string-index (str/index-of result "string")
-             length-index (str/index-of result "is too long (length:")]
-         (str (subs result 0 (+ 6 string-index)) " " (subs result length-index)))
-       error))
-   errors))
+  [error]
+  (if-let [result (re-find #"\w+ string .*is too long \(length: \d+, maximum allowed: \d+\)" (str/replace error "\n" ""))]
+    (let [string-index (str/index-of result "string")
+          length-index (str/index-of result "is too long (length:")]
+      (str (subs result 0 (+ 6 string-index)) " " (subs result length-index)))
+    error))

 (defn- get-collection-validation-errors
   "Collect the following collection validations:
@@ -218,7 +216,7 @@
   (remove empty?
    (concat
      (extract-errors-from-collection (:collection record)) ; Errors from translating to UMM
-     (reformat-error-messages (validate-record-schemas record))
+     (map reformat-error-message (validate-record-schemas record))
      (umm-validation/validate-collection record))))

 (defn- translate-and-validation-collection
@@ -337,7 +335,7 @@

 (comment
   ;; Translate and validate a specific collection by concept-id
-  (def record (get-collection "C1214604828-SCIOPS"))
+  (def record (get-collection "C1214598113-SCIOPS"))
   (translate-and-validation-collection record)
   (translate-record-to-umm record)
   (:metadata-format record)


Allow reload of a custom text game on the player

Before, the current game was being written as text on the game, on each
turn. Now, I replaced the raw text with an editable textarea and added a
load button. If the textarea is changed, that new str is stored, and
when the button is pressed the current game is replaced with the loaded
one.

Still has some issues (sometimes the Ai doesn't play on a loaded game),
but it's already a great way to have a visual representation of any
game.

--- src/obb_demo/views/player.cljs
+++ src/obb_demo/views/player.cljs
@@ -8,6 +8,7 @@
             [obb-rules.unit :as unit]
             [obb-rules.host-dependent :as host]
             [obb-rules.serializer.writer :as writer]
+            [obb-rules.serializer.reader :as reader]
             [obb-demo.processor :as processor]
             [obb-demo.views.power-bar :as power-bar]
             [obb-rules.ai.firingsquad :as firingsquad]
@@ -248,10 +249,31 @@
    [:option "Firingsquad"]
    [:option "Alamo"]])

+(defn- game-str-changed
+  "Called then the textarea with the game str is changed by the user"
+  [game-data ev]
+  (state/set-page-data! (assoc game-data :game-str (-> ev .-target .-value))))
+
+(defn- load-game-str
+  "Loads the game from a string on the game data"
+  [game-data]
+  (let [game-str (:game-str game-data)
+        new-game (reader/str->game game-str)]
+    (state/set-page-data!
+      (-> game-data
+          (dissoc :game-str)
+          (assoc :game new-game)))))
+
 (defn- game-as-string
   [game-data]
-  [:pre {:style {:margin-top "10px"}}
-    (writer/game->str (:game game-data))])
+  [:div.row
+    [:textarea {:style {:margin-top "10px"
+                        :height "500px"}
+                :class "form-control"
+                :on-change (partial game-str-changed game-data)
+                :value (or (:game-str game-data)
+                           (writer/game->str (:game game-data)))}]
+    [:button.btn.btn-primary {:on-click (partial load-game-str game-data)} "Load"]])

 (defn render
   [state]


Fixed selector in example/simple.

Fixed selector in example/simple.

--- examples/simple/src/simple/core.cljs
+++ examples/simple/src/simple/core.cljs
@@ -60,7 +60,7 @@
 (alive/defsnippet clock [] template [:./example-clock]
   [:./example-clock]
   (alive/set-attr :style {:color @(rf/subscribe [:time-color])})
-  [:./example-clock2]
+  [:./example-clock]
   (alive/content (-> @(rf/subscribe [:time])
                      .toTimeString
                      (clojure.string/split " ")


partly implemented functionality with night start games

--- src/mafia_votecount/scraper/team_liquid.clj
+++ src/mafia_votecount/scraper/team_liquid.clj
@@ -142,10 +142,14 @@
            (string/trim)
            (vector)
            (some #(let [lowercased (string/lower-case %)]
-                    (and
-                     (or (.startsWith lowercased "day ")
-                         (.startsWith lowercased "night "))
-                     (not (.contains lowercased "vot")))))))
+                    (cond
+                         (and
+                           (.startsWith lowercased "day ")
+                           (not (.contains lowercased "vot"))) :day
+                         (and
+                           (.startsWith lowercased "night ")
+                           (not (.contains lowercased "vot"))) :night
+                         :else false)))))

 (defn- cycle-changes [indexed hosts]
   (filter #(and (is-host? % hosts) (is-cycle-change? (:message (val %))))


Post id's are hopefully correct again

Post id's are hopefully correct again

--- src/mafia_votecount/scraper/team_liquid.clj
+++ src/mafia_votecount/scraper/team_liquid.clj
@@ -239,7 +239,7 @@
     :last-cycle-error)) ;; This should never happen

 (defn- scan-votes [player-message-maps hosts first-index cycle-number cycle-type]
-  (let [first-page-index (* (quot first-index POSTS-PER-PAGE) POSTS-PER-PAGE)
+  (let [first-page-index (inc (* (quot (dec first-index) POSTS-PER-PAGE) POSTS-PER-PAGE))
         indexed (->> (enumerate player-message-maps first-page-index)
                      (drop-while #(<= (first %) first-index))
                      (into (sorted-map)))


fix: use DB functions for ...

fix: use DB functions for ...

creating extractmanagement. Not because it is better, just because that is what we do now. With extra advantage that we can make use of the cleanup functions. We insert in the main table (without feature_type addition).

--- src/main/clojure/pdok/featured/extracts.clj
+++ src/main/clojure/pdok/featured/extracts.clj
@@ -31,46 +31,36 @@

 (defn features-for-extract [dataset feature-type extract-type features templates-dir]
   "Returns the rendered representation of the collection of features for a given feature-type inclusive tiles-set"
-  (if (empty? features)
+  (if (empty? features)
     [nil nil]
     (let [template (template templates-dir dataset feature-type extract-type)
           partials (partials templates-dir dataset extract-type)]
       (if (or (nil? template) (nil? partials))
-        [(str "Template or partials cannot be found for dataset: " dataset
-                                                    " feature-type: " feature-type
-                                                    " extract-type: " extract-type
+        [(str "Template or partials cannot be found for dataset: " dataset
+                                                    " feature-type: " feature-type
+                                                    " extract-type: " extract-type
                                                     " template-dir: " templates-dir) nil]
-        [nil (map #(vector (:_tiles %) (m/render template % partials) (:_valid_from %) (:_valid_to %)) features)]))))
-
-
-(defn create-extract-collection [db table]
-    (do (when (not (pg/schema-exists? db extract-schema))
-          (pg/create-schema db extract-schema))
-        (when (not (pg/table-exists? db extract-schema table))
-          (pg/create-table db extract-schema table
-                     [:id "bigserial" :primary :key]
-                     [:valid_from "timestamp without time zone"]
-                     [:valid_to "timestamp without time zone"]
-                     [:tiles "text"]
-                     [:xml "text"]
-                     [:created_on "timestamp without time zone"]
-                     )
-          )))
+        [nil (map #(vector feature-type (:_tiles %) (m/render template % partials)
+                           (:_valid_from %) (:_valid_to %)) features)]))))

 (defn- jdbc-insert-extract [db table entries]
    (try (j/with-db-connection [c db]
           (apply (partial j/insert! c (str extract-schema "." table) :transaction? false
-                    [:valid_from :valid_to :tiles :xml :created_on])
-                    entries))
+                    [:feature_type :valid_from :valid_to :tiles :xml])
+                    entries))
         (catch java.sql.SQLException e (j/print-sql-exception-chain e))))

-(defn add-extractset [db extractset version]
+(defn get-or-add-extractset [db extractset version]
+  "return id"
   (let [query (str "select id from " extractset-table " where extractset_name = ? and version = ?")]
     (j/with-db-connection [c db]
-      (let [result (j/query c [query extractset version])]
+      (let [result (j/query c [query extractset version])]
         (if (empty? result)
-          (j/insert! db extractset-table {:extractset_name extractset :version version :active false})
-          result)))))
+          (do
+            (j/query c [(str "SELECT " extract-schema ".add_extractset(?,?)") extractset (int version)])
+            (get-or-add-extractset db extractset version))
+
+          (:id (first result)))))))

 (defn add-extractset-area [db extractset-id tiles]
   (let [query (str "select * from " extractset-area-table " where extractset_id = ? and area_id = ?")]
@@ -79,34 +69,34 @@
         (if (empty? (j/query c [query extractset-id area-id]))
           (j/insert! db extractset-area-table {:extractset_id extractset-id :area_id area-id}))))))

-(defn- tiles-from-feature [[tiles & more]]
+(defn- tiles-from-feature [[type tiles & more]]
    tiles)

-(defn add-metadata-extract-records [db dataset extract-type version rendered-features]
-   (let [extractset-id (:id (first (add-extractset db (str dataset "_" extract-type) version)))
-         tiles (reduce clojure.set/union (map tiles-from-feature rendered-features))]
+(defn add-metadata-extract-records [db extractset-id rendered-features]
+   (let [tiles (reduce clojure.set/union (map tiles-from-feature rendered-features))]
      (add-extractset-area db extractset-id tiles)))

-(defn- tranform-feature-for-db [[tiles xml-feature valid-from valid-to]]
-  [valid-from valid-to (vec tiles) xml-feature nil])
+(defn- tranform-feature-for-db [[feature-type tiles xml-feature valid-from valid-to]]
+  [feature-type valid-from valid-to (vec tiles) xml-feature])

 (defn add-extract-records [db dataset feature-type extract-type version rendered-features]
   "Inserts the xml-features and tile-set in an extract schema based on dataset, extract-type, version and feature-type,
    if schema or table doesn't exists it will be created."
-  (let [table (str dataset "_" extract-type "_v" version "_" feature-type)]
+  (let [collection (str dataset "_" extract-type)
+        table (str collection "_v" version)
+        extractset-id (get-or-add-extractset db collection version) ]
     (do
-      (create-extract-collection db table)
       (jdbc-insert-extract db table (map tranform-feature-for-db rendered-features))
-      (add-metadata-extract-records db dataset extract-type version rendered-features))
+      (add-metadata-extract-records db extractset-id rendered-features))
     (count rendered-features)))

 (defn fill-extract [dataset collection extract-type extract-version]
   (let [feature-type collection
         features (timeline/all (config/timeline) dataset collection)
-        [error features-for-extract] (features-for-extract dataset
-                                                           feature-type
-                                                           extract-type
-                                                           features
+        [error features-for-extract] (features-for-extract dataset
+                                                           feature-type
+                                                           extract-type
+                                                           features
                                                            "src/main/resources/pdok/featured/templates")]
     (if (nil? error)
       (if (nil? features-for-extract)


timeline _version _version is the value of the latest feature :version

--- src/main/clojure/pdok/featured/timeline.clj
+++ src/main/clojure/pdok/featured/timeline.clj
@@ -27,6 +27,7 @@
                [:dataset "varchar(100)"]
                [:collection "varchar(255)"]
                [:feature_id "varchar(100)"]
+               [:version "uuid"]
                [:valid_from "timestamp without time zone"]
                [:valid_to "timestamp without time zone"]
                [:feature "text"]
@@ -38,6 +39,7 @@
                [:dataset "varchar(100)"]
                [:collection "varchar(255)"]
                [:feature_id "varchar(100)"]
+               [:version "uuid"]
                [:valid_from "timestamp without time zone"]
                [:valid_to "timestamp without time zone"]
                [:feature "text"]
@@ -114,6 +116,7 @@
          mustafied (mustafy feature)
          merger (path->merge-fn target keyworded-path)
          merged (merger mustafied)
+         merged (assoc merged :_version (:version feature))
          merged (update merged :_tiles #(clojure.set/union % (tiles/nl (:geometry feature))) )]
      merged)))

@@ -124,13 +127,13 @@
   (assoc acc :_valid_to (:validity feature)))

 (defn- new-current-sql []
-  (str "INSERT INTO " (qualified-current) " (dataset, collection, feature_id, valid_from, valid_to, feature, tiles)
-VALUES (?, ?, ? ,?, ?, ?, ?)"))
+  (str "INSERT INTO " (qualified-current) " (dataset, collection, feature_id, version, valid_from, valid_to, feature, tiles)
+VALUES (?, ?, ? ,?, ?, ?, ?, ?)"))

 (defn- new-current
   ([db features]
    (try
-     (let [transform-fn (juxt :_dataset :_collection :_id :_valid_from :_valid_to pg/to-json :_tiles)
+     (let [transform-fn (juxt :_dataset :_collection :_id :_version :_valid_from :_valid_to pg/to-json :_tiles)
            records (map transform-fn features)]
        (j/execute! db (cons (new-current-sql) records) :multi? true :transaction? false))
       (catch java.sql.SQLException e (j/print-sql-exception-chain e))))
@@ -157,6 +160,7 @@
 (defn- update-current-sql []
   (str "UPDATE " (qualified-current) "
 SET feature = ?,
+    version = ?,
     valid_from = ?,
     valid_to = ?,
     tiles = ?
@@ -164,18 +168,18 @@

 (defn- update-current [db features]
   (try
-    (let [transform-fn (juxt pg/to-json :_valid_from :_valid_to :_tiles :_dataset :_collection :_id)
+    (let [transform-fn (juxt pg/to-json :_version :_valid_from :_valid_to :_tiles :_dataset :_collection :_id)
           records (map transform-fn features)]
       (j/execute! db (cons (update-current-sql) records) :multi? true :transaction? false))
     (catch java.sql.SQLException e (j/print-sql-exception-chain e))))

 (defn- new-history-sql []
-  (str "INSERT INTO " (qualified-history) " (dataset, collection, feature_id, valid_from, valid_to, feature, tiles)
-VALUES (?, ?, ?, ?, ?, ?, ?)"))
+  (str "INSERT INTO " (qualified-history) " (dataset, collection, feature_id, version, valid_from, valid_to, feature, tiles)
+VALUES (?, ?, ?, ?, ?, ?, ?, ?)"))

 (defn- new-history [db features]
   (try
-    (let [transform-fn (juxt :_dataset :_collection :_id :_valid_from :_valid_to pg/to-json :_tiles)
+    (let [transform-fn (juxt :_dataset :_collection :_id :_version :_valid_from :_valid_to pg/to-json :_tiles)
           records (map transform-fn features)]
       (j/execute! db (cons (new-history-sql) records) :multi? true :transaction? false))
     (catch java.sql.SQLException e (j/print-sql-exception-chain e))))


remove {:synsem {:essere false}} from transitive

--- src/babel/francais/pos.clj
+++ src/babel/francais/pos.clj
@@ -61,8 +61,7 @@
                       :subcat {:1 {:agr agr}}}})))
 (def transitive
   (unifyc verb-subjective
-          pos/transitive
-          {:synsem {:essere false}}))
+          pos/transitive))

 (def intransitive-unspecified-obj
   (unifyc verb-subjective


Remove unused sub

Remove unused sub

--- src/braid/client/subs.cljs
+++ src/braid/client/subs.cljs
@@ -216,16 +216,6 @@
                                   (get-in @state [:tags thread-id])) @tag-ids)))]
       tags)))

-(reg-sub-raw
-  :mentions-for-thread
-  (fn [state [_ thread-id]]
-    (let [mention-ids (reaction (get-in @state [:threads thread-id :mentioned-ids]))
-          mentions (reaction (doall
-                               (map (fn [user-id]
-                                      (get-in @state [:users user-id]))
-                                    @mention-ids)))]
-      mentions)))
-
 (reg-sub
   :messages-for-thread
   (fn [state [_ thread-id]]


headings should handle strings in the path

This can happen in the case of recommendations where we can't look up a
predefined title in the translation table

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -56,7 +56,8 @@
                      {:id (hash path)})
     (when-let [numbers (get path-to-numbers path)]
       (section-numbers numbers))
-    (layout/translations (last path))]))
+    (let [title (last path)]
+      (if (keyword? title) (layout/translations title) title))]))

 (def ^:private running-header-class-name "running-header")


Whitespace and code layout fixes

Whitespace and code layout fixes

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -736,9 +736,7 @@

       (let [subitems (get items fmt)]
         [:fo:flow {:flow-name "xsl-region-body"}
-         (cover-page [title
-                      "Filme mit Audiodeskription"]
-                     date)
+         (cover-page [title "Filme mit Audiodeskription"] date)
          (toc subitems [fmt] 1 {:heading? true})
          (mapcat #(genre-sexp (get subitems %) fmt % 1 {:show-genre? false}) (keys subitems))])]]))

@@ -756,8 +754,7 @@

       (let [subitems (get items fmt)]
         [:fo:flow {:flow-name "xsl-region-body"}
-         (cover-page ["Spiele in der SBS"]
-                     date)
+         (cover-page ["Spiele in der SBS"] date)
          (toc subitems [fmt] 1 {:heading? true})
          (mapcat #(genre-sexp (get subitems %) fmt % 1 {:show-genre? false}) (keys subitems))])]]))


core/calc detects unknown points and notes that in [:result :unknown :points]

--- src/clj/ephemeris/core.clj
+++ src/clj/ephemeris/core.clj
@@ -83,18 +83,20 @@
       {:points
         (into {}
           (for [i (flatten [(:points want)])]
-            (let [what (if (known? i) (lookup i) i)
-                  res (double-array 6)
-                  err (StringBuffer.)
-                  rc (.swe_calc_ut sw
-                                   jd
-                                   what
-                                   flag
-                                   res
-                                   err)]
-              {(lookup what) {:lon (aget res 0)
-                              :lat (aget res 1)
-                              :sdd (aget res 3)}})))}
+            (if (and (not (known? i)) (keyword? i))
+              (do (result re [:unknown :points] i) {})
+              (let [what (if (known? i) (lookup i) i)
+                    res (double-array 6)
+                    err (StringBuffer.)
+                    rc (.swe_calc_ut sw
+                                     jd
+                                     what
+                                     flag
+                                     res
+                                     err)]
+                {(lookup what) {:lon (aget res 0)
+                                :lat (aget res 1)
+                                :sdd (aget res 3)}}))))}
       (if (and (geo? (:geo want))
                (or (angles? (:angles want))
                    (houses? (:houses want))))
@@ -115,5 +117,6 @@
                         :result @re})))))

 (comment
+  (calc {:points [:Sun :NA]})
   (calc {:utc "1974-06-30T21:45:00Z"
          :geo {:lat 43.217 :lon 27.917}}))


Use sorted maps and sets when creating ns declaration.

--- src/clj/seria/prettify.clj
+++ src/clj/seria/prettify.clj
@@ -92,7 +92,7 @@
   (cond
     (namespaced-symbol? form)
     (let [[namespace function] (split-symbol form)]
-      {namespace #{function}})
+      (sorted-map namespace (sorted-set function)))

     (or (map? form)
         (sequential? form))


whitespace

whitespace

--- src/clj/shale/sessions.clj
+++ src/clj/shale/sessions.clj
@@ -313,7 +313,7 @@
   [pool :- SessionPool
    options :- CreateArg]
   (logging/info (format "Creating a new session.\nOptions: %s"
-                (pretty options)))
+                        (pretty options)))

   (if (= 0 (count (nodes/nodes-under-capacity (:node-pool pool))))
     (throw


Add timeout support. Needs a bit of cleanup still

--- src/clj_tutorials/core.clj
+++ src/clj_tutorials/core.clj
@@ -65,3 +65,24 @@
     (doseq [c cs]
         (go (chan-http-get url c)))
     (repeatedly number-of-users #(collect-result cs))))
+
+
+; (STEP 6 "With timeout")
+
+(defn chan-http-get-with-timeout [url timeout result-c]
+  (let [start (System/currentTimeMillis)
+        c (async/chan)
+        timeout-c (async/timeout timeout)]
+    (go
+      (http/get url {} #(async/put! c [(- (System/currentTimeMillis) start)
+                                       (= 200 (:status %))]))
+      (let [[result channel] (async/alts! [c timeout-c])]
+        (if (= timeout-c channel)
+          (async/put! result-c [timeout false])
+          (async/put! result-c result))))))
+
+(defn run-non-blocking-with-timeout [number-of-users timeout url]
+  (let [cs (repeatedly number-of-users async/chan)]
+    (doseq [c cs]
+        (go (chan-http-get-with-timeout url timeout c)))
+    (repeatedly number-of-users #(collect-result cs))))


Add bench function

Add bench function

--- src/clj_tutorials/core.clj
+++ src/clj_tutorials/core.clj
@@ -52,3 +52,14 @@
     (doseq [c cs]
       (go (>! c (step))))
     (repeatedly number-of-users #(collect-result cs))))
+
+(defn bench [function]
+  (let [start (System/currentTimeMillis)
+        result (function)]
+    [(- (System/currentTimeMillis) start) result]))
+
+(defn run-with-bench [number-of-users step]
+  (with-channels [cs number-of-users]
+    (doseq [c cs]
+      (go (>! c (bench step))))
+    (repeatedly number-of-users #(collect-result cs))))


Don't refer atom function

Don't refer atom function

--- src/cljs/cglossa/core.cljs
+++ src/cljs/cglossa/core.cljs
@@ -1,6 +1,6 @@
 (ns cglossa.core
-  (:require [reagent.core :as reagent :refer [atom]]
             [plumbing.core :as plumbing :refer [map-vals]]
+  (:require [reagent.core :as r]
             [ajax.core :refer [GET]]
             [cglossa.start :as start]
             [cglossa.results :as results]))
@@ -41,7 +41,7 @@
       [:img.textlab-logo {:src "img/tekstlab.gif"}]]]))

 (defn ^:export main []
-  (reagent/render-component
+  (r/render-component
     (fn []
       [app app-state app-data])
     (. js/document (getElementById "app"))))


Display only file or folder name, not full path

--- src/cljs/repodoc/core.cljs
+++ src/cljs/repodoc/core.cljs
@@ -26,8 +26,10 @@
 (defn node
   [item]
   (let [path (get item "path")
-        level (count (clojure.string/split path "/"))]
-    (nm (str "div.level" level) path)))
+        parts (clojure.string/split path "/")
+        level (count parts)
+        base (last parts)]
+    (nm (str "div.level" level) base)))

 (defn reporender
   [data]


cljs/skyport.core: Fix too long laser

cljs/skyport.core: Fix too long laser

The laser was too long after discovery that the height was calculated incorrectly.

--- src/cljs/skyport/core.cljs
+++ src/cljs/skyport/core.cljs
@@ -213,9 +213,8 @@
          [x_2 y_2] (coords-to-pixel stop)
          x_d (- x_1 x_2)
          y_d (- y_1 y_2)
-         height (+ TILE-SIZE
-                   (js/Math.sqrt (+ (js/Math.pow x_d 2)
-                                    (js/Math.pow y_d 2))))
+         height (js/Math.sqrt (+ (js/Math.pow x_d 2)
+                                 (js/Math.pow y_d 2)))
          width 20
          angle (* (js/Math.atan2 x_d y_d)
                   (/ -180 js/Math.PI))]
@@ -262,6 +261,7 @@
                           :label "D"
                           :position [j k]})
                        {:key :position})])))
+
 (defn droid-shot [{:keys [sequence from]} owner]
   (reify
     om/IInitState


fix small empty search field bug

fix small empty search field bug

--- src/cljs/unfolds/core.cljs
+++ src/cljs/unfolds/core.cljs
@@ -131,7 +131,7 @@
 (defn search [owner {:keys [sync current-item]}] ;; XXX: current-item really?
   (let [search (-> (om/get-node owner "search")
                    .-value)]
-    (when search
+    (when (and search (not= search ""))
       (put! sync {:op :search :data {:subs search}}))))

 (defn search-view [items owner {:keys [current-item sync]}]


Increase indexing deep to 50

Increase indexing deep to 50

--- src/cljx/subman/const.cljx
+++ src/cljx/subman/const.cljx
@@ -22,7 +22,7 @@
                  type-subscene "Subscene"
                  type-all "all"})

-(def update-deep 10)
+(def update-deep 50)

 (def update-period (* 5 60 1000))


[#9680] Show proper storage for keycard accounts

--- src/status_im/ui/screens/wallet/account_settings/views.cljs
+++ src/status_im/ui/screens/wallet/account_settings/views.cljs
@@ -40,7 +40,8 @@

 (defview account-settings []
   (letsubs [{:keys [address color path type] :as account} [:multiaccount/current-account]
-            new-account (reagent/atom nil)]
+            new-account (reagent/atom nil)
+            keycard? [:keycard-multiaccount?]]
     [react/keyboard-avoiding-view {:flex 1}
      [topbar/topbar
       (cond-> {:title :t/account-settings}
@@ -90,7 +91,10 @@
             {:copied-text path}
             [react/text {:style {:margin-top 6 :font-family "monospace"}} path]]])
         (when-not (= type :watch)
-          [property (i18n/label :t/storage) (i18n/label :t/this-device)])]
+          [property (i18n/label :t/storage)
+           (i18n/label (if keycard?
+                         :t/keycard
+                         :t/this-device))])]
        (when (= type :watch)
          [react/view
           [react/view {:margin-bottom 8 :margin-top 28 :height 1 :background-color colors/gray-lighter}]


fix: use resource url instead of its name.

--- ssclj/tools/src/com/sixsq/slipstream/tools/cli/ssconfig.clj
+++ ssclj/tools/src/com/sixsq/slipstream/tools/cli/ssconfig.clj
@@ -129,7 +129,7 @@

 (defn cfg-tpl-slipstream
   []
-  (get (:configuration *templates*) (str cfgt/resource-name "/" cfg-s/service)))
+  (get (:configuration *templates*) (str cfgt/resource-url "/" cfg-s/service)))

 (defn complete-config
   "Add missing keys to satisfy schema."


Add more tests

Add more tests

--- test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
+++ test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
@@ -202,20 +202,53 @@
                  (using (array-map :timestamp 42
                                    :ttl       24)))))

-
   (is (= "INSERT INTO foo(a,b) VALUES ({2,3,4},3.4) USING TIMESTAMP 42 AND TTL 24;"
          (insert :foo
                  (values ["a" "b"]
-                         (object-array
-                          [(doto (java.util.TreeSet.)
-                             (.add 2)
-                             (.add 3)
-                             (.add 4))
-                           3.4]))
+                         [(doto (java.util.TreeSet.)
+                            (.add 2)
+                            (.add 3)
+                            (.add 4))
+                          3.4])
                  (using (array-map :timestamp 42
-                                   :ttl       24))
-                 )
-         ))
+                                   :ttl       24)))))
+
+  (is (= "INSERT INTO foo(a,b) VALUES ({2,3,4},3.4) USING TTL ? AND TIMESTAMP ?;"
+         (insert :foo
+                 (values [:a :b]
+                         [(doto (java.util.TreeSet.)
+                            (.add 2)
+                            (.add 3)
+                            (.add 4))
+                          3.4])
+                 (using (array-map :ttl       (?)
+                                   :timestamp (?))))))
+
+  (is (= "INSERT INTO foo(c,a,b) VALUES (123,{2,3,4},3.4) USING TIMESTAMP 42;"
+         (insert :foo
+                 (value :c 123)
+                 (values [:a :b]
+                         [(doto (java.util.TreeSet.)
+                            (.add 2)
+                            (.add 3)
+                            (.add 4))
+                          3.4]
+                         )
+                 (using {:timestamp 42}))))
+
+  (is (thrown? IllegalArgumentException
+               (insert :foo
+                       (values [:a :b]
+                               [1 2 3]))))
+
+  (is (= "INSERT INTO foo(k,x) VALUES (0,1) IF NOT EXISTS;";
+         (insert :foo
+                 (value :k 0)
+                 (value :x 1)
+                 (if-not-exists))))
+
+  (is (= "INSERT INTO foo(k,x) VALUES (0,(1));";
+         (insert :foo
+                 (value :k 0)
+                 (value :x (tuple-of [:int] [(int 1)])))))
   )
-
-


Improve TodoMVC comment

Improve TodoMVC comment

--- examples/todomvc/src/todomvc/db.cljs
+++ examples/todomvc/src/todomvc/db.cljs
@@ -14,8 +14,7 @@
 (def lsk "todos-reframe")     ;; local store key

 (defn ls->todos
-  "Read in a map of todos from local storage, and process into a
-  sorted-map, suitable for merging into app-db."
+  "Read in todos from LS, and process into a form we can merge into app-db."
   []
   (some->> (.getItem js/localStorage lsk)
            (cljs.reader/read-string)


Accept non-localhost connections in pedestal (#2632)

Without this, the client machine running wrk cannot connect to the
server and so pedestal gets zero RPS.

--- frameworks/Clojure/pedestal/src/pedestal/pdg.clj
+++ frameworks/Clojure/pedestal/src/pedestal/pdg.clj
@@ -266,7 +266,7 @@
   [service-map server-opts]
   (let [handler (::handler service-map)
         {:keys [host port join?]
-         :or {host "127.0.0.1"
+         :or {host "0.0.0.0"
               port 8080
               join? false}} server-opts
         addr (InetSocketAddress. ^String host ^int port)