Move everything into map-svg

Move everything into map-svg

--- src-cljs/frontend/components/pieces/map.cljs
+++ src-cljs/frontend/components/pieces/map.cljs
@@ -82,6 +82,26 @@

 (defn strut-position [config columns tx ty]
   (- (first (arrow-end config tx ty)) (strut-offset config columns tx ty)))
+
+(defn has-far-arrows? [graph columns node]
+  (zero? (g/out-degree (g/subgraph graph (conj (apply concat (rest columns)) node))
+                       node)))
+
+(defn build-columns [{:keys [graph remaining-ranks columns]}]
+  (if (empty? remaining-ranks)
+    columns
+    (let [{far-arrows false no-far-arrows true}
+          (group-by #(has-far-arrows? graph columns %) (first remaining-ranks))
+          next-column
+          (if far-arrows
+            (let [height-to-clear (->> (conj columns no-far-arrows) (map count) (apply max))
+                  padding (- height-to-clear (count no-far-arrows))]
+              (concat no-far-arrows (take padding (repeat nil)) far-arrows))
+            no-far-arrows)]
+      (recur
+       {:graph graph
+        :remaining-ranks (rest remaining-ranks)
+        :columns (conj columns next-column)}))))

 (defn map-layout [{:keys [box-width box-height arrow-radius] :as config} columns edges]
   (let [coords (into {}
@@ -111,8 +131,11 @@
         :height box-height
         :content thing})}))

-(defn map-svg [{:keys [box-width box-height arrow-radius] :as config} columns edges]
-  (let [{:keys [arrows boxes]} (map-layout config columns edges)]
+(defn map-svg [{:keys [box-width box-height arrow-radius] :as config} g]
+  (let [columns (build-columns {:graph g
+                                :remaining-ranks (reverse (ranks g))
+                                :columns ()})
+        {:keys [arrows boxes]} (map-layout config columns (g/edges g))]
     (html
      [:div {:style {:background "white"}}
       [:svg {:width "2000"
@@ -130,26 +153,6 @@
                    :y 25}
             content]])]]])))

-(defn has-far-arrows? [graph columns node]
-  (zero? (g/out-degree (g/subgraph graph (conj (apply concat (rest columns)) node))
-                       node)))
-
-(defn build-columns [{:keys [graph remaining-ranks columns]}]
-  (if (empty? remaining-ranks)
-    columns
-    (let [{far-arrows false no-far-arrows true}
-          (group-by #(has-far-arrows? graph columns %) (first remaining-ranks))
-          next-column
-          (if far-arrows
-            (let [height-to-clear (->> (conj columns no-far-arrows) (map count) (apply max))
-                  padding (- height-to-clear (count no-far-arrows))]
-              (concat no-far-arrows (take padding (repeat nil)) far-arrows))
-            no-far-arrows)]
-      (recur
-       {:graph graph
-        :remaining-ranks (rest remaining-ranks)
-        :columns (conj columns next-column)}))))
-
 (dc/do
   (def json
     "[
@@ -259,32 +262,13 @@

   (defcard map
     (let [g (transitive-reduction frontend-graph)
-          columns (build-columns {:graph g
-                                  :remaining-ranks (reverse (ranks g))
-                                  :columns ()})
-          edges (conj (g/edges g)
-                      ["cljsbuild_test" "precompile_assets"]
-                      ["npm_bower_dependencies" "cljsbuild_whitespace"])
           config {:box-width 150
                   :box-height 40
                   :x-spacing 100
                   :y-spacing 10
                   :strut-spacing 20
                   :arrow-radius 10}]
-      (html
-       [:div
-        #_(show-columns columns)
-        (map-svg config columns (g/edges g))
-        (map-svg config (-> columns
-                            vec
-                            (assoc 2 [nil "cljsbuild_test" "cljsbuild_whitespace" "cljsbuild_production" "clojure_test"]))
-                 edges)
-        (map-svg config (-> columns
-                            vec
-                            (update 1 conj nil)
-                            (assoc 2 ["cljsbuild_whitespace" "cljsbuild_production" "cljsbuild_test" "clojure_test"])
-                            (assoc 3 ["precompile_assets" "cljs_test"]))
-                 edges)])))
+      (map-svg config g)))

   (defcard arrow
     (html


Use monospaced font

Use monospaced font

--- src/datafrisk/core.cljs
+++ src/datafrisk/core.cljs
@@ -144,6 +144,8 @@
       (let [data-frisk (:data-frisk @state-atom)
             visible? (:visible? data-frisk)]
         [:div {:style (merge {:position "fixed"
+                              :fontFamily "Consolas,Monaco,Courier New,monospace"
+                              :fontSize "12px"
                               :right 0
                               :bottom 0
                               :width "100%"


Clean-up function

Clean-up function

--- src/braid/server/sync.clj
+++ src/braid/server/sync.clj
@@ -23,14 +23,13 @@
 ;; Handler helpers

 (defn broadcast-thread
-  "broadcasts thread to all subscribed users, except those in ids-to-skip"
+  "broadcasts thread to all users with the thread open, except those in ids-to-skip"
   [thread-id ids-to-skip]
-  (let [subscribed-user-ids (db/users-with-thread-open thread-id)
-        user-ids-to-send-to (-> (difference
-                                  (intersection
-                                    (set subscribed-user-ids)
-                                    (set (:any @connected-uids)))
-                                  (set ids-to-skip)))
+  (let [user-ids (-> (difference
+                       (intersection
+                         (set (db/users-with-thread-open thread-id))
+                         (set (:any @connected-uids)))
+                       (set ids-to-skip)))
         thread (db/thread-by-id thread-id)]
     (doseq [uid user-ids-to-send-to]
       (let [user-tags (db/tag-ids-for-user uid)


Use keyword conversion in maps, too.

Use keyword conversion in maps, too.

--- src/cheshire/generate.clj
+++ src/cheshire/generate.clj
@@ -61,7 +61,7 @@
        (let [k# (key m#)
              v# (val m#)]
          (.writeFieldName ~jg (if (keyword? k#)
-                                (.substring (str k#) 1)
+                                (~key-fn k#)
                                 (str k#)))
          (generate ~jg v# ~date-format ~e ~key-fn)))
      (.writeEndObject ~jg)))


CLJS-858: resolve-existing-var does not check vars outside current namespace

Prior to this commit we would only check vars if the prefix of the
var was the current namespace. This means normal library usage
is not verified. Instead now we check if the var is either:

A) an implicit require/import, i.e. goog.string, Math, etc.
B) is from a JS namespace (just verify the namespace)
C) exists in a CLJS namespace

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -279,11 +279,16 @@
          (throw err#)
          (throw (error ~env (.getMessage err#) err#))))))

+(defn implicit-import? [env prefix suffix]
+  (contains? '#{goog goog.object goog.string goog.array Math} prefix))
+
 (defn confirm-var-exists [env prefix suffix]
-  (let [crnt-ns (-> env :ns :name)]
-    (when (and (= prefix crnt-ns)
-               (not (get-in @env/*compiler* [::namespaces crnt-ns :defs suffix])))
-      (warning :undeclared-var env {:prefix prefix :suffix suffix}))))
+  (when (and (not (implicit-import? env prefix suffix))
+             (not (and (not (get-in @env/*compiler* [::namespaces prefix]))
+                       (or (get (:requires (:ns env)) prefix)
+                           (get (:imports (:ns env)) prefix))))
+             (not (get-in @env/*compiler* [::namespaces prefix :defs suffix])))
+    (warning :undeclared-var env {:prefix prefix :suffix suffix})))

 (defn resolve-ns-alias [env name]
   (let [sym (symbol name)]


Get rid of a few threading macros kibit doesn't like.

I don't know clojure that well, so I'm assuming kibit is right.

--- src/clj/freefrog/lang.clj
+++ src/clj/freefrog/lang.clj
@@ -38,8 +38,9 @@
   (g/add-role-to-circle circle name purpose domains accountabilities))

 (defn create-circle [circle {:keys [name purpose domains accountabilities]}]
-  (-> (g/add-role-to-circle circle name purpose domains accountabilities)
-      (g/convert-to-circle name)))
+  (g/convert-to-circle
+    (g/add-role-to-circle circle name purpose domains accountabilities)
+    name))

 ;;Note: this function may show up as unused in IntelliJ but it is because
 ;;      metaprogramming!
@@ -160,8 +161,7 @@
    (execute-governance nil governance-string))

   ([circle governance-string]
-   (let [parsed-document (-> governance-string
-                             parse-governance)]
+   (let [parsed-document (parse-governance governance-string)]
      (if (insta/failure? parsed-document)
        (throw (RuntimeException. (pr-str parsed-document)))
        (reduce process-command circle parsed-document)))))


Fix status on search request

Fix status on search request

--- src/clj/subman/routes.clj
+++ src/clj/subman/routes.clj
@@ -7,6 +7,6 @@

 (defroutes main-routes
   (GET "/" [] (views/index-page))
+  (GET "/search/*" [] (views/index-page))
   (GET "/api/search/" {params :params} (api/search params))
-  (route/resources "/")
-  (route/not-found (views/index-page)))
+  (route/resources "/"))


CLJS-816: clojure.set/rename-keys accidentally deletes keys when there's a collision.

--- src/cljs/clojure/set.cljs
+++ src/cljs/clojure/set.cljs
@@ -72,13 +72,12 @@
 (defn rename-keys
   "Returns the map with the keys in kmap renamed to the vals in kmap"
   [map kmap]
-    (reduce
+    (reduce
      (fn [m [old new]]
-       (if (and (not= old new)
-                (contains? m old))
-         (-> m (assoc new (get m old)) (dissoc old))
-         m))
-     map kmap))
+       (if (contains? map old)
+         (assoc m new (get map old))
+         m))
+     (apply dissoc map (keys kmap)) kmap))

 (defn rename
   "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap"


simplify currying

simplify currying

--- src/cljs/gaugin/core.cljs
+++ src/cljs/gaugin/core.cljs
@@ -91,46 +91,46 @@
   [data frame]
   (let [width 1080
         height 920
-        color (-> d3 .-scale .category10)
-        force (-> d3 .-layout .force (.charge -100)  (.linkDistance 20) (.size [width height]))
-        svg (-> d3
-                (.select frame)
-                (.append "svg")
-                (.attr {:width width
+        color (.. d3 -scale category10)
+        force (.. d3 -layout force (charge -100)  (linkDistance 20) (size [width height]))
+        svg (.. d3
+                (select frame)
+                (append "svg")
+                (attr {:width width
                         :height height}))]
-    (-> force
-        (.nodes (.-nodes data))
-        (.links (.-links data))
-        .start)
-    (let [link (-> svg
-                   (.selectAll ".link")
-                   (.data (.-links data))
-                   .enter
-                   (.append "line")
-                   (.attr {:class "link"})
-                   (.style {:stroke-with (fn [d] (.sqrt js/Math (.-value d)))}))
-          node (-> svg
-                   (.selectAll ".node")
-                   (.data (.-nodes data))
-                   .enter
-                   (.append "circle")
-                   (.attr {:class "node"
+    (.. force
+        (nodes (.-nodes data))
+        (links (.-links data))
+        start)
+    (let [link (.. svg
+                   (selectAll ".link")
+                   (data (.-links data))
+                   enter
+                   (append "line")
+                   (attr {:class "link"})
+                   (style {:stroke-with (fn [d] (.sqrt js/Math (.-value d)))}))
+          node (.. svg
+                   (selectAll ".node")
+                   (data (.-nodes data))
+                   enter
+                   (append "circle")
+                   (attr {:class "node"
                            :r "4"})
-                   (.style {:fill (fn [d] (color (.-group d)))})
-                   (.call (.-drag force)))]
+                   (style {:fill (fn [d] (color (.-group d)))})
+                   (call (.-drag force)))]
       (do
-        (-> node (.append "title") (.text (fn [d] (.-value d))))
-        (-> force
-            (.on "tick"
+        (.. node (append "title") (text (fn [d] (.-value d))))
+        (.. force
+            (on "tick"
                  (fn []
-                   (-> link
-                       (.attr
-                        {:x1 #(-> % .-source .-x)
-                         :y1 #(-> % .-source .-y)
-                         :x2 #(-> % .-target .-x)
-                         :y2 #(-> % .-target .-y)}))
-                   (-> node
-                       (.attr {:cx #(.-x %)
+                   (.. link
+                       (attr
+                        {:x1 #(.. % -source -x)
+                         :y1 #(.. % -source -y)
+                         :x2 #(.. % -target -x)
+                         :y2 #(.. % -target -y)}))
+                   (.. node
+                       (attr {:cx #(.-x %)
                                :cy #(.-y %)})))))))))


WIP on adding cards

WIP on adding cards

--- src/cljs/memoria/app.cljs
+++ src/cljs/memoria/app.cljs
@@ -9,6 +9,9 @@
   "Will reduce the contents of a card to n characters and if it gets reduced add on ..."
   [n s]
   (s/join [(if (> (count s) n) (str (subs s 0 n) "...") s)]))
+
+(defn bind-input [input-atom]
+  #(reset! input-atom (-> %1 .-target .-value)))

 (def jquery (js* "$"))

@@ -62,44 +65,43 @@

 (defn add-card-modal []
   (let [title (r/atom nil)
-        content (r/atom nil)
+        contents (r/atom nil)
         tags (r/atom nil)
         on-add-card-submit (fn [event params]
-                           (.preventDefault event)
-                           (create-card {:title title
-                                         :content content
-                                         :tags tags}))]
+                             (.preventDefault event)
+                             (create-card {:title @title
+                                           :contents @contents
+                                           :tags @tags}))]

-    [:div {:class "ui segment modal" :key "add-card-modal"}
+    [:div {:key "add-card-modal"}
      [:h2 {:class "ui center aligned icon header"}
       [:i {:class "circular plus purple icon"}]
       [:content {:class "content"} "Add card"]]

-    [:form {:class "ui small form"}
-     [:div {:class "required field"}
-      [:label "Title"]
-      [:input {:type "text"}]]
-     [:div {:class "required field"}
-      [:label "Content"]
-      [:textarea {:rows "5"}]]
-     [:div {:class "field"}
-      [:label "Tags"]
-      [:input {:type "text"}]]
-     [:button {:class "ui center aligned button" :type "submit"} "Submit"]]]))
+     [:form {:class "ui small form" :action "#" :on-submit on-add-card-submit}
+      [:div {:class "required field"}
+       [:label "Title"]
+       [:input {:type "text" :on-change (bind-input title)}]]
+      [:div {:class "required field"}
+       [:label "Content"]
+       [:textarea {:rows "5" :on-change (bind-input contents)}]]
+      [:div {:class "field"}
+       [:label "Tags"]
+       [:input {:type "text" :on-change (bind-input tags)}]]
+      [:button {:class "ui center aligned button" :type "submit"} "Submit"]]]))

-(defn add-card-button [show-modal]
-  [:button {:class "circular ui icon button massive" :key "add-card-button" :on-click show-modal}
-   [:i {:class "icon plus purple"}]])
+(defn add-card-button []
+  (let [on-click (fn []
+                   (r/render [add-card-modal] (.getElementById js/document "modal"))
+                   (-> (jquery "#modal")
+                            (.modal "show")))]
+    [:button {:class "circular ui icon button massive" :key "add-card-button" :on-click on-click}
+     [:i {:class "icon plus purple"}]]))

 (defn add-card-component []
-  (let [on-click (fn [] (-> (jquery ".ui.modal")
-                            (.modal "show")))]
-
   [:div {:class "add-card" :key "add-card-component"}
-   [add-card-button on-click]
-   [add-card-modal]]))
-
+   [add-card-button]])

 (defn cards-list-component [cards]
   [:div#cards-container {:class "ui grid sixteen container" :key "cards-list-container"}
@@ -119,7 +121,7 @@
        [:input {:class "prompt"
                 :type "text"
                 :placeholder "Search for cards..."
-                :on-change #(reset! search-term (-> %1 .-target .-value))}]]]]))
+                :on-change (bind-input search-term)}]]]]))

 (defn index-page-component []
   [:div


Semi-stable snapshot of my latest playing with om, so I can switch gear and refactor the number generation in a more useful way.

--- src/cljs/primes/core.cljs
+++ src/cljs/primes/core.cljs
@@ -104,13 +104,51 @@
             (dom/button #js {:onClick #(add-more app)}
                         "show more"))))

+(defn counter-view [app owner]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:expanded false})
+    om/IRenderState
+    (render-state [_ {:keys [expanded]}]
+      (dom/div #js {:className "counter-view-test"}
+               "Simple expander test: "
+               (dom/div
+                #js {:onClick (fn [e] (om/set-state! owner :expanded (not expanded)))}
+                (if expanded "EXPANDED" "NOT EXPANDED"))))))
+
+
+(defn group-view-new
+  "Render the contents of one group (set) of numbers."
+  [app owner]
+  (let [signature [1 1]
+        numbers [4 5 6 7 8 9 10 "...dummy data..."]]
+    (reify
+      om/IInitState
+      (init-state [_]
+        {:expanded false})
+      om/IRenderState
+      (render-state [_ {:keys [expanded]}]
+        (dom/li nil
+                (dom/b nil
+                       (str/join ", " signature))
+                " [" (nums/vector-magnitude signature) "]"
+                (dom/br nil)
+                (count numbers) ": " (+ 3 4 )
+                (dom/span #js {:onClick (fn [e] (om/set-state! owner :expanded (not expanded)))}
+                           (dom/small nil (if expanded
+                                            (dom/i nil (str/join ", " numbers))
+                                            "CLICK TO EXPAND"))))))))

 (defn group-view
   "Render the contents of one group (set) of numbers."
   [[signature numbers] owner]
   (reify
-    om/IRender
-    (render [this]
+    om/IInitState
+    (init-state [_]
+      {:expanded false})
+    om/IRenderState
+    (render-state [_ {:keys [expanded]}]
       (dom/li nil
               (dom/b nil (str/join ", " signature))
               " [" (nums/vector-magnitude signature) "]"
@@ -128,6 +166,9 @@
       (dom/div nil
                (om/build title app)
                (om/build numseq app)
+               (om/build counter-view app {})
+               (dom/ul nil
+                      (om/build group-view-new app {}))
                (apply dom/ul nil
                       (om/build-all group-view (nums/group-signatures (:up-to app))))))))


Remove ^:export from quil.sketch/sketch.

--- src/cljs/quil/sketch.cljs
+++ src/cljs/quil/sketch.cljs
@@ -71,7 +71,7 @@
       (set! (.-quil prc) (atom nil)))))

-(defn ^:export sketch
+(defn sketch
   [app-name & opts]
   (let [opts-map (apply hash-map opts)
         host-elem (dom/get-element (:host opts-map))


Handle the unknown-slashcommand message

Handle the unknown-slashcommand message

--- web-app/src/cljs/potato/core.cljs
+++ web-app/src/cljs/potato/core.cljs
@@ -451,6 +451,9 @@
   (let [cid (:channel e)]
     (om/transact! (state-root) [:channels cid :options]
       (fn [_] e))))
+
+(defn- handle-unknown-slashcommand [e]
+  (cljs.pprint/cl-format true "Should display error message here. Unknown command: ~a" (:cmd e)))

 (defn dispatch-notification-entry [entry async-channel]
   (cljs.pprint/cl-format true "Got server message: ~s" entry)
@@ -488,6 +491,9 @@
     ;; Interactive options
     "option"
     (handle-interactive-option entry)
+    ;; Unknown slashcommand
+    "unknown-slashcommand"
+    (handle-unknown-slashcommand entry)
     ;; Log any unhandled event types
     (cljs.pprint/cl-format true "Unknown type: ~s" entry)))


explorations text info added

explorations text info added

--- src/crawler/extractor.clj
+++ src/crawler/extractor.clj
@@ -122,6 +122,13 @@
                                 (fn [[xpath links-text]]
                                   [xpath (set (map first links-text))])
                                 xpaths-hrefs-tks))
+
+             xpaths-text'     (into
+                               {}
+                               (map
+                                (fn [[xpath links-text]]
+                                  [xpath (set (map second links-text))])
+                                xpaths-hrefs-tks))

              in-host-map      (in-host-xpaths-hrefs
                                xpaths-hrefs' (uri/host sampled))
@@ -152,6 +159,7 @@
              {:url                 sampled
               :novelty             (novelty diff)
               :hrefs-table         in-host-map
+              :text-table          xpaths-text'
               :in-host-hrefs-table in-host-map
               :update              (update original-hrefs current-hrefs)}))))
      sampled-uris)))
@@ -209,6 +217,21 @@
          (merge-with set/union acc v))
        {}
        (map #(-> % :hrefs-table) xpath-explorations)))
+    explorations)))
+
+(defn text-table
+  [explorations]
+  (reduce
+   (fn [acc v]
+     (merge-with set/union acc v))
+   {}
+   (map
+    (fn [{xpath :xpath xpath-explorations :explorations}]
+      (reduce
+       (fn [acc v]
+         (merge-with set/union acc v))
+       {}
+       (map #(-> % :text-table) xpath-explorations)))
     explorations)))

 (defn update-table
@@ -286,6 +309,13 @@
                                    [xpath (set (map first links-text))])
                                  xpaths-hrefs-text))

+         xpaths-text           (into
+                                {}
+                                (map
+                                 (fn [[xpath links-text]]
+                                   [xpath (set (map second links-text))])
+                                 xpaths-hrefs-text))
+
          xpaths                (map first xpaths-hrefs)

          ;; WTF?
@@ -302,9 +332,11 @@
          in-host-xpaths        (map first in-host-xpath-hrefs)

          signature             (into
-                                {} (map (fn [an-xpath]
-                                          [an-xpath (count (xpaths-hrefs an-xpath))])
-                                        xpaths))
+                                {}
+                                (map
+                                 (fn [an-xpath]
+                                   [an-xpath (count (xpaths-hrefs an-xpath))])
+                                 xpaths))

          explorations          (map
                                 (fn [[xpath hrefs]]
@@ -328,6 +360,9 @@
          hrefs                 (merge-with
                                 set/union ih-xp-map (href-table explorations))

+         tokens                (merge-with
+                                set/union ih-xp-map (text-table explorations))
+
          novelties             (novelty-table explorations)

          updates               (update-table explorations)]
@@ -335,9 +370,11 @@
      {:src-link             url
       :explorations         explorations
       :xpaths-hrefs         xpaths-hrefs
+      :xpaths-text          xpaths-text
       :signature            signature
       :dfs                  dfs
       :hrefs                hrefs
+      :tokens               tokens
       :novelties            novelties
       :updates              updates
       :in-host-xpaths-hrefs in-host-xpath-hrefs})))


Remove require of removed EmailVerifier

Remove require of removed EmailVerifier

--- src/cylon/verify_mail.clj
+++ src/cylon/verify_mail.clj
@@ -2,7 +2,7 @@
   (:require
    [clojure.tools.logging :refer :all]
    [com.stuartsierra.component :as component]
-   [cylon.signup.protocols :refer (render-simple-message  EmailVerifier send-email! Emailer)]
+   [cylon.signup.protocols :refer (render-simple-message send-email! Emailer)]
    [cylon.token-store :refer (create-token! get-token-by-id purge-token!)]
    [cylon.totp :refer (OneTimePasswordStore set-totp-secret get-totp-secret totp-token secret-key)]


Delete obsolete dev namespace

Delete obsolete dev namespace

It only ever really existed as a buffer against failed
refreshes. Between boot and not using a wrapper library over
tools.namespace, it just didn't serve any purpose.

--- dev/dev.clj
+++ dev/dev.clj
@@ -1,18 +0,0 @@
-(ns dev
-  ;; TODO: Just make it go away
-  "This ns is pointless"
-  (:require [clojure.edn :as edn]
-            [clojure.inspector :as i]
-            [clojure.java.io :as io]
-            [clojure.pprint :refer (pprint)]
-            [clojure.reflect :as reflect]
-            [clojure.repl :refer :all]  ; dir is very useful
-            [clojure.spec.alpha :as s]
-            [clojure.spec.gen.alpha :as gen]
-            [clojure.string :as string]
-            [clojure.test :as test]
-            [clojure.tools.logging :as log]
-            [clojure.tools.namespace.repl :refer (refresh refresh-all)]
-            [manifold.stream :as strm]))
-
-(def system nil)


make-qname accept nil prefix

make-qname accept nil prefix

--- src/main/clojure/clojure/data/xml/jvm/name.clj
+++ src/main/clojure/clojure/data/xml/jvm/name.clj
@@ -25,4 +25,4 @@
      (QName/valueOf s))))

 (definline make-qname [uri name prefix]
-  `(QName. ~uri ~name ~prefix))
+  `(QName. ~uri ~name (or ~prefix "")))


fix cljs-env->env

fix cljs-env->env

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -576,7 +576,7 @@
                                                                   m)) {} r))
                     core-mappings (apply dissoc (get-in (env/deref-env) [:namespaces 'cljs.core :mappings]) excludes)
                     core-macro-mappings (apply dissoc (core-macros) excludes)
-                    js-namespaces (reduce (fn [m ns] (assoc m ns {:ns ns :js-namespace true})) {} (set (keys requires)))
+                    js-namespaces (reduce (fn [m ns] (assoc m ns {:ns ns :js-namespace true})) {} (set (vals requires)))

                     mappings (reduce-kv (fn [m k v] (assoc m k {:op   (if (js-namespaces v) :js-var :var)
                                                                :name k
@@ -596,6 +596,6 @@
                               :macro-mappings (merge core-macro-mappings macro-mappings)
                               :aliases        (parse-requires requires)
                               :macro-aliases  (parse-requires require-macros)}})))
-            (vals @(cljs.ana/namespaces)))))
+            {} (vals @cljs.ana/namespaces))))

 (setup-rt!)


Fixed several tests in the job-data-fetcher module

--- test/emender_jenkins/job_data_fetcher_test.clj
+++ test/emender_jenkins/job_data_fetcher_test.clj
@@ -25,55 +25,55 @@

 (deftest test-minutes-to-seconds-existence
-    "Check that the emender-jenkins.job-data_fetcher/minutes-to-seconds definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/minutes-to-seconds definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/minutes-to-seconds))))
+    "Check that the emender-jenkins.job-data-fetcher/minutes-to-seconds definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/minutes-to-seconds definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/minutes-to-seconds))))

 (deftest test-seconds-to-ms-existence
-    "Check that the emender-jenkins.job-data_fetcher/seconds-to-ms definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/seconds-to-ms definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/seconds-to-ms))))
+    "Check that the emender-jenkins.job-data-fetcher/seconds-to-ms definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/seconds-to-ms definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/seconds-to-ms))))

 (deftest test-compute-sleep-amount-existence
-    "Check that the emender-jenkins.job-data_fetcher/compute-sleep-amount definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/compute-sleep-amount definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/compute-sleep-amount))))
+    "Check that the emender-jenkins.job-data-fetcher/compute-sleep-amount definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/compute-sleep-amount definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/compute-sleep-amount))))

 (deftest test-fetch-data-existence
-    "Check that the emender-jenkins.job-data_fetcher/fetch-data definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/fetch-data definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/fetch-data))))
+    "Check that the emender-jenkins.job-data-fetcher/fetch-data definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/fetch-data definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/fetch-data))))

 (deftest test-try-to-fetch-data-existence
-    "Check that the emender-jenkins.job-data_fetcher/try-to-fetch-data definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/try-to-fetch-data definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/try-to-fetch-data))))
+    "Check that the emender-jenkins.job-data-fetcher/try-to-fetch-data definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/try-to-fetch-data definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/try-to-fetch-data))))

 (deftest test-get-formatted-time-existence
-    "Check that the emender-jenkins.job-data_fetcher/get-formatted-time definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/get-formatted-time definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/get-formatted-time))))
+    "Check that the emender-jenkins.job-data-fetcher/get-formatted-time definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/get-formatted-time definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/get-formatted-time))))

 (deftest test-run-fetcher-in-a-loop-existence
-    "Check that the emender-jenkins.job-data_fetcher/run-fetcher-in-a-loop definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/run-fetcher-in-a-loop definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/run-fetcher-in-a-loop))))
+    "Check that the emender-jenkins.job-data-fetcher/run-fetcher-in-a-loop definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/run-fetcher-in-a-loop definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/run-fetcher-in-a-loop))))

 (deftest test-run-fetcher-existence
-    "Check that the emender-jenkins.job-data_fetcher/run-fetcher definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/run-fetcher definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/run-fetcher))))
+    "Check that the emender-jenkins.job-data-fetcher/run-fetcher definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/run-fetcher definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/run-fetcher))))

 (deftest test-run-fetcher-in-thread-existence
-    "Check that the emender-jenkins.job-data_fetcher/run-fetcher-in-thread definition exists."
-    (testing "if the emender-jenkins.job-data_fetcher/run-fetcher-in-thread definition exists."
-        (is (callable? 'emender-jenkins.job-data_fetcher/run-fetcher-in-thread))))
+    "Check that the emender-jenkins.job-data-fetcher/run-fetcher-in-thread definition exists."
+    (testing "if the emender-jenkins.job-data-fetcher/run-fetcher-in-thread definition exists."
+        (is (callable? 'emender-jenkins.job-data-fetcher/run-fetcher-in-thread))))


Flash cue label when ending.

Flash cue label when ending.

--- src/afterglow/controllers/ableton_push_2.clj
+++ src/afterglow/controllers/ableton_push_2.clj
@@ -992,9 +992,13 @@
                   info        (first fx-meta)
                   ending      ((:key info) (:ending fx-info))
                   cue         (:cue info)
-                  color       (if cue
-                                (cues/current-cue-color cue effect (:show controller) snapshot)
-                                white-color)
+                  base-color       (if cue
+                                     (cues/current-cue-color cue effect (:show controller) snapshot)
+                                     white-color)
+                  color (when base-color
+                          (if (and ending (> (rhythm/snapshot-beat-phase snapshot) 0.4))
+                            (colors/darken base-color 40)
+                            base-color))
                   width       (* 2 button-cell-width)
                   left        (* x width)
                   scroll-vars (> (count (:variables cue)) 2)


Stash leapfrog, just in case

Stash leapfrog, just in case

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -315,7 +315,40 @@
         (Iterator. (.-max-keys tree) node -1 true))
       (recur (aget (.-children node) 0)))))

-
+(deftype Intersection [iterators end?]
+  Object
+  (key [this]
+       (when (false? end?)
+         (.key (aget iterators 0))))
+  (search [this current]
+          (when (false? end?)
+            (loop [current current]
+              (let [max-key (.key (aget iterators (mod (- current 1) (alength iterators))))
+                    min-key (.key (aget iterators current))]
+                (when-not (== min-key max-key)
+                  (.seek (aget iterators current))
+                  (if (.-end? (aget iterators current))
+                    (set! end? true)
+                    (recur (mod (+ current 1) (alength iterators)))))))))
+  (next [this]
+        (when (false? end?)
+          (.next (aget iterators 0))
+          (if (.-end? (aget iterators 0))
+            (set! end? true)
+            (.search (+ current 1)))))
+  (seek [this key]
+        (when (false? end?)
+          (.seek (aget iterators 0) key)
+          (if (.-end? (aget iterators 0))
+            (set! end? true)
+            (.search (+ current 1))))))
+
+(defn intersection [iterators]
+  (if (> (alength iterators) 1)
+    (if (some #(.-end? %) iterators)
+      (Intersection. iterators true)
+      (Intersection. (into-array (sort-by #(.key %) compare-keys iterators)) false))
+    (aget iterators 0)))

 ;; TESTS


improve logging

improve logging

--- src/babel/engine.cljc
+++ src/babel/engine.cljc
@@ -119,10 +119,12 @@
                                       (:index language-model)
                                       (:morph language-model))]
       (if (not (empty? result))
-        (log/info (str "successfully generated with:"
+        (log/info (str "successfully generated:"
+                       "'" ((:morph language-model) (first result)) "'"
+                       "with:"
                        {:language (:language language-model)
                         :model (:name language-model)
-                        :spec spec} " => '" ((:morph language-model) (first result)) "'"))
+                        :spec spec}))
         (log/warn (str "generate-all: failed to generate with: "
                        {:language (:language language-model)
                         :model (:name language-model)


added back button to service logs

added back button to service logs

--- src/cljs/swarmpit/component/service/log.cljs
+++ src/cljs/swarmpit/component/service/log.cljs
@@ -88,7 +88,12 @@
      [:div.form-panel
       [:div.form-panel-left
        (comp/panel-info icon/services
-                        (:serviceName service))]]
+                        (:serviceName service))]
+      [:div.form-panel-right
+       (comp/mui
+         (comp/raised-button
+           {:href  (routes/path-for-frontend :service-info (select-keys service [:id]))
+            :label "Back"}))]]
      [:div.log-panel
       [:div.form-panel-left
        (comp/panel-text-field


Verify config path before starting up

Verify config path before starting up

Prior to this commit, if the config path that the user
specified did not exist or was not readable, we'd silently
ignore it and then fail a bit later with a confusing
error message about not finding a "vardir" setting.

This commit adds a bit of explicit checking to make
sure that the specified config path exists and is
readable before we try to parse the ini file(s).

--- src/com/puppetlabs/puppetdb/cli/services.clj
+++ src/com/puppetlabs/puppetdb/cli/services.clj
@@ -178,10 +178,16 @@
   config)

 (defn parse-config
-  "Parses the given config file (if present) and configure its various
+  "Parses the given config file/directory and configures its various
   subcomponents."
-  [file]
-  (let [config (if file (inis-to-map file) {})]
+  [path]
+  (let [file (file path)]
+    (if-not (and (.exists file)
+                 (.canRead file))
+      (throw (IllegalArgumentException.
+        (format "Configuration path '%s' must be exist and must be readable." path)))))
+
+  (let [config (if path (inis-to-map path) {})]
     (-> config
         (configure-logging!)
         (configure-commandproc-threads)


Update sample web ui dependencies

Update sample web ui dependencies

Reviewers: #core_team, fromberger

Reviewed By: #core_team, fromberger

Subscribers: #core_team

Differential Revision: https://phabricator-dot-kythe-repo.appspot.com/D2077

--- kythe/web/ui/project.clj
+++ kythe/web/ui/project.clj
@@ -6,13 +6,13 @@
                  :post "https://groups.google.com/group/kythe/post"
                  :subscribe "http://groups.google.com/group/kythe/boxsubscribe"
                  :unsubscribe "http://groups.google.com/group/kythe/boxsubscribe"}
-  :dependencies [[org.clojure/clojure "1.7.0"]
-                 [org.clojure/clojurescript "0.0-2371"
+  :dependencies [[org.clojure/clojure "1.8.0"]
+                 [org.clojure/clojurescript "1.9.946"
                   :exclusions [org.apache.ant/ant]]
-                 [org.clojure/core.async "0.1.346.0-17112a-alpha"]
-                 [om "0.8.0-alpha2"]
-                 [cljs-ajax "0.3.3"]]
-  :plugins [[lein-cljsbuild "1.1.0"]
+                 [org.clojure/core.async "0.3.465"]
+                 [org.omcljs/om "0.9.0"]
+                 [cljs-ajax "0.7.3"]]
+  :plugins [[lein-cljsbuild "1.1.1"]
             [lein-licenses "0.2.0"]]
   :hooks [leiningen.cljsbuild]
   :cljsbuild {


make disqus work

make disqus work

--- src/blogiseq/core.clj
+++ src/blogiseq/core.clj
@@ -49,9 +49,8 @@
    <script>
    var disqus_config = function () {
    this.page.url = this.page.url = 'http://example.com/helloworld.html'; // todo
-   this.page.identifier = 'single-id-so-far'; // todo
+   this.page.identifier = 'single-id-for-whole-page-so-far'; // todo
    };
-   */
    (function() {  // DON'T EDIT BELOW THIS LINE
    var d = document, s = d.createElement('script');

@@ -75,6 +74,7 @@
     [:div.left left]
     [:div.right (generate-menu-navi "resources/meta.edn")]
     [:div.middle [:div content
+                  [:div#disqus_thread]
                   [:div "<script id=\"dsq-count-scr\" src=\"//frankysblogiseq.disqus.com/count.js\" async></script>"]]
     ]]])


Lookup functions from dummy environment

Lookup functions from dummy environment

--- src/icfp2014/compiler.clj
+++ src/icfp2014/compiler.clj
@@ -16,8 +16,27 @@
            [:add "; inc"]])
    'dec (fn [x]
           [x
-           [:ldc 1 "; inc"]
-           [:sub "; inc"]])})
+           [:ldc 1 "; dec"]
+           [:sub "; dec"]])})
+
+(defn load-var
+  [vars name]
+  (let [index (.indexOf vars name)]
+    (if-not (neg? index)
+      [:ld 0 index (format "; load var %s" name)])))
+
+(defn load-fn
+  ([fns name]
+   (load-fn 1 fns name))
+  ([frame fns name]
+   (if-let [func (first (filter #(= (:name %) name) fns))]
+     [:ld frame (.indexOf fns func) (format "; load fn %s" name)])))
+
+(defn load-symbol
+  [fns vars name]
+  (if-let [load-stmt (or (load-fn fns name) (load-var vars name))]
+    load-stmt
+    (throw (IllegalArgumentException. (format "Could not find symbol %s" name)))))

 (defn compile-form
   [vars fns form]
@@ -31,9 +50,7 @@
     (macros form)

     (symbol? form)
-    (if (some #(= (:name %) form) fns)
-      [[:ldf form]]
-      [[:ld 0 (.indexOf vars form)]])
+    [(load-symbol fns vars form)]

     (vector? form)
     (if (empty? form)
@@ -43,18 +60,18 @@
               (repeat (count form) [:cons])))

     (seq? form)
-    (let [[fn-name & args] form
-          evaled-args (mapcat #(compile-form vars fns %) args)]
+    (let [[fn-name & args] form]
       (if (= fn-name 'quote)
         (concat (mapcat #(compile-form vars fns %) (first args))
                 (repeat (dec (count form)) [:cons]))
-        (if (builtins fn-name)
-          (apply (builtins fn-name) evaled-args)
-          (concat
-            ;; Push the args onto the stack
-            evaled-args
-            [[:ldf fn-name]
-             [:ap (count args)]]))))
+        (let [evaled-args (mapcat #(compile-form vars fns %) args)]
+          (if (builtins fn-name)
+            (apply (builtins fn-name) evaled-args)
+            (concat
+              ;; Push the args onto the stack
+              evaled-args
+              [(load-fn fns fn-name)
+               [:ap (count args)]])))))

     :else
     (throw (IllegalArgumentException. (format "Don't know how to compile %s which is %s" form (type form))))))
@@ -90,7 +107,7 @@
   [fns]
   ;; This depends on the initial state we want
   (let [code [[:ldc 0 "; define main"]
-              [:ldf 'step]
+              (load-fn 0 fns 'step)
               [:cons]
               [:rtn]]
         main {:name 'main


Primary re-wiring/finishing of the postgres backend

--- src/doctopus/storage/impls/postgres_impl.clj
+++ src/doctopus/storage/impls/postgres_impl.clj
@@ -3,13 +3,19 @@
             [doctopus.files :as f])
   (:import [java.nio.file Files Paths]))

-(def is-img-regex
-  #"\.(png|pdf|jpg|jpeg|gif|ico|){1}$")
+(def is-img-regex #"^image")

 (defn get-mime-type
-  [path-str]
-  (let [path (Paths/get path-str (into-array String []))]
+  [f]
+  (let [path (.toPath f)]
     (Files/probeContentType path)))
+
+(defn assign-body-and-image
+  [base-doc doc-path mime-type]
+  (let [doc-content (slurp doc-path)]
+    (if (re-find is-img-regex mime-type)
+      (assoc base-doc :body :image :image (.getBytes doc-content))
+      (assoc base-doc :body doc-content :image nil))))

 (defn save-fn
   "Load every document from a directory in to the database.
@@ -24,13 +30,14 @@
   (let [relpath-file-pairs (f/list-files-with-relative-paths src-dir)
         tent-name (:name tentacle)]
     (doseq [[relpath doc-file] relpath-file-pairs
-            :let [new-doc {:name (str tent-name "-" (.getName doc-file))
-                           :body (slurp doc-file)
-                           :path doc-file
-                           :type (get-mime-type doc-file)
-                           :uri (str tent-name "/" relpath)
-                           :tentacle-name tent-name}]]
-      (db/save-document! new-doc))
+            :let [doc-mime-type (get-mime-type doc-file)
+                  base-doc {:name (str tent-name "-" (.getName doc-file))
+                            ;; :path doc-file
+                            :mime-type doc-mime-type
+                            :uri (str tent-name "/" relpath)
+                            :tentacle-name tent-name}
+                  new-doc (assign-body-and-image base-doc doc-file doc-mime-type)]]
+      (db/save-document! new-doc false))
     (db/update-document-index)))

 (defn load-fn


Fix wrong padding calculation.

Fix wrong padding calculation.

--- src/bytebuf/bytes.clj
+++ src/bytebuf/bytes.clj
@@ -17,11 +17,11 @@
   "Given a byte array, returns a number of bytes
   allocated with zero padding (zero byte)."
   [^bytes input]
-  (let [mark (byte 0)
-        pos (reduce (fn [previndex index]
-                      (let [value (aget input index)]
-                        (if (= value mark)
-                          index
-                          (reduced previndex))))
-                    (reverse (range (count input))))]
-    (- (count input) pos)))
+  (let [mark (byte 0)]
+    (reduce (fn [sum index]
+              (let [value (aget input index)]
+                (if (= value mark)
+                  (inc sum)
+                  (reduced sum))))
+            0
+            (reverse (range (count input))))))


Adds untrain-user-phrase function.

Adds untrain-user-phrase function.

--- src/cadence/model.clj
+++ src/cadence/model.clj
@@ -133,7 +133,7 @@
   "Returns cadences to be used to train a classifier as a tuple of bad cadences
   and good cadences."
   [user-id phrase]
-  (let [find-cadences (fn [by-user l]
+  (let [find-cadences (fn [by-user lim]
                         (mq/with-collection "cadences"
                           (mq/find {:phrase phrase
                                  :user_id (if by-user
@@ -141,9 +141,23 @@
                                             {$ne user-id})
                                  :random_point {"$near" [(rand) 0]}})
                           (mq/fields [:timeline :phrase])
-                          (mq/limit l)
+                          (mq/limit lim)
                           (mq/snapshot)))]
     [(find-cadences false 200) (find-cadences true 50)]))
+
+(defn untrain-user-phrase
+  "User id from users array for the given phrase and the related cadences."
+  [user-id phrase-id]
+  ;; Remove user from specified phrase
+  (let [user-oid (ObjectId. user-id)
+        phrase-oid (ObjectId. phrase-id)]
+    (mc/update-by-id "phrases" phrase-oid
+                     {$pull {:users user-oid}
+                      $inc {:usersCount -1}})
+    ;; Remove related cadences
+    (mc/remove "cadences" {:phrase_id phrase-oid
+                           :user_id user-oid}))
+  )

 (defn store-classifier
   "Stores the given classifier with the given user/phrase pair."


Specifies that the users index is unique.

--- src/cadence/model.clj
+++ src/cadence/model.clj
@@ -9,7 +9,7 @@
         [cemerick.friend.credentials :only [hash-bcrypt]]))

 (defn- ensure-indexes []
-  (mc/ensure-index "users" {:username 1}))
+  (mc/ensure-index "users" {:username 1} {:unique 1 :dropDups 1}))

 (defn connect [connection-info]
   (if (:uri connection-info)


Add another producer code for Paderborn

Add another producer code for Paderborn

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -136,6 +136,7 @@
    24 "DZB, Leipzig"
    102 "DZB, Leipzig"
    25 "CAB, Landschlacht"
+   32 "Blindenschrift-Verlag, Paderborn"
    40 "BIT, München"
    50 "BSVÖ, Wien"
    103 "Blindenschrift-Verlag, Paderborn"


Add checkboxes, fixes #2

Add checkboxes, fixes #2

--- src/lolitemsets/core.cljs
+++ src/lolitemsets/core.cljs
@@ -12,7 +12,7 @@
 ;; define your app data so that it doesn't get over-written on reload

 (defonce app-state (atom {:text "Hello world!"
-                          :props [algo/build-dps]
+                          :props #{}
                           :recommended []}))

 (go
@@ -27,12 +27,12 @@
                             (swap! app-state
                               #(assoc %1 :champ (get-in %1 [:champs %2]))
                               (keyword (-> event .-target .-value))))}
-     (for [[id ch] (:champs @app-state)]
+     (for [[id ch] (sort-by (comp :name val) (:champs @app-state))]
        [:option {:key id :value id} (:name ch)])]])

 (defn champion-image []
   [:img {:src (str "http://ddragon.leagueoflegends.com/cdn/img/champion/loading/"
-                   (:id (:champ @app-state))
+                   (:id (:champ @app-state) "Aatrox")
                    "_0.jpg")}])

 (defn recommend []
@@ -47,11 +47,29 @@
     [:ul (for [item (:recommended @app-state)]
            [:li (:name item)])])

+(defn objective-checkbox [name objective]
+  (letfn [(toggle [event]
+            (swap! app-state update-in [:props]
+                   (if (-> event .-target .-checked) conj disj)
+                   objective))]
+  [:label
+   name
+   [:input {:type :checkbox :on-change toggle}]]))
+
+(defn needlesly-large-button []
+  [:button {:on-click recommend} "Recommend"])
+
 (defn hello-world []
   [:div
     [:h1 (:text @app-state)]
     [champion-select]
     [champion-image]
+    [:div
+      [objective-checkbox "Attack damaeg per second" algo/build-dps]
+      [objective-checkbox "Life Steal per second" algo/build-lsps]
+      [objective-checkbox "Effective Health (AP)" algo/build-hp-ap]
+      [objective-checkbox "Effective Health (AD)" algo/build-hp-ad]]
+    [needlesly-large-button]
     [item-recommendation]])

 (reagent/render-component [hello-world]


* src/clj/cljs/core.clj: remove core/get from multifn code

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -486,7 +486,7 @@
 		  `(~'-lookup [this# ~ksym else#]
          (cond
            ~@(mapcat (fn [f] [`(identical? ~ksym ~(keyword f)) f]) base-fields)
-           :else (core/get ~'__extmap ~ksym else#)))
+           :else (get ~'__extmap ~ksym else#)))
 		  'ICounted
 		  `(~'-count [this#] (+ ~(count base-fields) (count ~'__extmap)))
 		  'ICollection
@@ -943,19 +943,16 @@
     (when (= (count options) 1)
       (throw "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))
     (let [options   (apply hash-map options)
-          default   (core/get options :default :default)
-          ;; hierarchy (core/get options :hierarchy #'cljs.core.global-hierarchy)
-	  ]
+          default   (core/get options :default :default)]
       (check-valid-options options :default :hierarchy)
       `(def ~(with-meta mm-name m)
-	 (let [method-table# (atom {})
-	       prefer-table# (atom {})
-	       method-cache# (atom {})
-	       cached-hierarchy# (atom {})
-	       hierarchy# (core/get ~options :hierarchy cljs.core/global-hierarchy)
-	       ]
-	   (cljs.core.MultiFn. ~(name mm-name) ~dispatch-fn ~default hierarchy#
-			       method-table# prefer-table# method-cache# cached-hierarchy#))))))
+         (let [method-table# (atom {})
+               prefer-table# (atom {})
+               method-cache# (atom {})
+               cached-hierarchy# (atom {})
+               hierarchy# (get ~options :hierarchy cljs.core/global-hierarchy)]
+           (cljs.core.MultiFn. ~(name mm-name) ~dispatch-fn ~default hierarchy#
+                               method-table# prefer-table# method-cache# cached-hierarchy#))))))

 (defmacro defmethod
   "Creates and installs a new method of multimethod associated with dispatch-value. "


Get output directory from the repl-env.

Get output directory from the repl-env.

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -74,7 +74,7 @@
                      (= (first sym) 'quote))
               (second sym)
               sym)
-        opts {:output-dir ".repl"}
+        opts {:output-dir (get repl-env :working-dir ".repl")}
         deps (->> (cljsc/add-dependencies opts {:requires [(name sym)] :type :seed})
                   (remove (comp #{["goog"]} :provides))
                   (remove (comp #{:seed} :type))


Oops, was calculating lag until present.

--- src/mars_ogler/scrape.clj
+++ src/mars_ogler/scrape.clj
@@ -149,7 +149,11 @@
   (let [strs (select-keys img times/types)
         dates (into {} (for [[type date-str] strs]
                          [type (times/rfc-parser date-str)]))
-        lag (-> (time/interval (:taken-utc dates) (:released-utc dates))
+        taken (:taken-utc dates)
+        released (:released dates)
+        lag (-> (if (time/before? taken released)
+                  (time/interval taken released)
+                  (time/interval taken taken))
               times/format-interval)]
     (-> (merge img dates)
       (assoc :lag lag))))


Attempt to resume from previous checkpoint key if none exists

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -69,15 +69,20 @@
       (let [offset (inc (:offset (read-commit log k)))]
         (seek-to-offset! consumer {:topic topic :partition kpartition} offset))
       (catch org.apache.zookeeper.KeeperException$NoNodeException nne
-        (if-let [start-offsets (:kafka/start-offsets task-map)]
-          (let [offset (get start-offsets kpartition)]
-            (when-not offset
-              (throw (ex-info "Offset missing for existing partition when using :kafka/start-offsets"
-                              {:missing-partition kpartition
-                               :recoverable? false
-                               :kafka/start-offsets start-offsets})))
-            (seek-to-offset! consumer {:topic topic :partition kpartition} offset))
-          (cp/seek-to-beginning-offset! consumer [{:topic topic :partition kpartition}]))))))
+        (try
+         ;; Try again using 0.9.9.0/0.9.10.0 checkpoint method
+         ;; This allows users to transition to new checkpoint from old method
+         (let [offset (inc (:offset (extensions/read-chunk log :chunk k)))]
+           (seek-to-offset! consumer {:topic topic :partition kpartition} offset))
+         (catch org.apache.zookeeper.KeeperException$NoNodeException nne
+           (if-let [start-offsets (:kafka/start-offsets task-map)]
+             (let [offset (get start-offsets kpartition)]
+               (when-not offset
+                 (throw (ex-info "Offset missing for existing partition when using :kafka/start-offsets"
+                                 {:missing-partition kpartition
+                                  :kafka/start-offsets start-offsets})))
+               (seek-to-offset! consumer {:topic topic :partition kpartition} offset))
+             (cp/seek-to-beginning-offset! consumer [{:topic topic :partition kpartition}]))))))))

 (defn seek-offset! [log consumer group-id topic kpartition task-map]
   (if (and (:kafka/force-reset? task-map)


Modify javac task to enable passing javac options.

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -548,7 +548,7 @@

 (core/deftask javac
   "Compile java sources."
-  []
+  [o options OPTIONS [str] "List of options passed to the java compiler."]
   (let [tgt (core/tmp-dir!)]
     (core/with-pre-wrap fileset
       (let [throw?    (atom nil)
@@ -558,6 +558,7 @@
             file-mgr  (.getStandardFileManager compiler diag-coll nil nil)
             opts      (->> ["-d"  (.getPath tgt)
                             "-cp" (System/getProperty "boot.class.path")]
+                           (concat options)
                            (into-array String) Arrays/asList)
             handler   {Diagnostic$Kind/ERROR util/fail
                        Diagnostic$Kind/WARNING util/warn


Add `file?` predicate.

Add `file?` predicate.

--- src/datoteka/core.clj
+++ src/datoteka/core.clj
@@ -109,6 +109,11 @@
   [v]
   (instance? Path v))

+(defn file?
+  "Check if `v` is an instance of java.io.File"
+  [v]
+  (instance? File v))
+
 (defn absolute?
   "Checks if the provided path is absolute."
   [path]


Allow UV to be layered on top of a color.

--- src/afterglow/show.clj
+++ src/afterglow/show.clj
@@ -66,8 +66,8 @@

 (def resolution-order
   "The order in which assigners should be evaluated, by type key.
-  Lower-level assignments are resolved before more abstract ones."
-  [:channel :function :color :direction :aim])
+  Multi-channel assignments are resolved before individual ones."
+  [:color :direction :aim :channel :function])

 (defonce ^:private ^{:doc "Keeps track of the resolution orders for
   extensions which have been registered to the frame rendering loop.


Fix button

Fix button

--- src/discuss/find.cljs
+++ src/discuss/find.cljs
@@ -4,6 +4,7 @@
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
             [discuss.communication :as com]
+            [discuss.utils.bootstrap :as bs]
             [discuss.utils.common :as lib]
             [discuss.utils.views :as vlib]))

@@ -79,9 +80,7 @@
                                         :value       search-value
                                         :placeholder "Find Statement"})
                         (dom/span #js {:className "input-group-btn"}
-                                  (dom/button #js {:className "btn btn-primary"
-                                                   :type      "button"}
-                                              (vlib/fa-icon "fa-search fa-fw" #(find-statement search-value issue-id)))))))))
+                                  (bs/button-primary #(find-statement search-value issue-id) (vlib/fa-icon "fa-search fa-fw"))))))))

 (defn results-view []
   (reify om/IRender


Cleanup from the previous moving of the DB migrations to Yesql

--- src/blaagh/db/core.clj
+++ src/blaagh/db/core.clj
@@ -20,35 +20,9 @@
         (println e))))

 (defn create-tables []
-    (try
-        (sql/db-do-commands db-spec
-            "CREATE TABLE foo (name text); "
-            "CREATE TABLE bar (name text); "
-            "CREATE TABLE baz (name text); ")
-        (catch Exception e
-            (println e))))
-
-(defn create-tables-yesql []
     (create-table-foo!)
     (create-table-bar!)
     (create-table-baz!))

-(defn populate-tables-yesql []
+(defn populate-tables []
     (populate-table-foo!))
-
-(defn populate-tables-DEPRECATED []
-    (try
-        (sql/db-do-commands db-spec
-            "INSERT INTO foo (name) VALUES
-                ('Rick'),
-                ('Carol'),
-                ('Daryl'),
-                ('Michonne'),
-                ('Glenn'),
-                ('Maggie'),
-                ('Carl'),
-                ('Sasha'),
-                ('Abraham'),
-                ('Morgan');")
-        (catch Exception e
-            (println e))))


Renamed curr-world to prog-world.

Renamed curr-world to prog-world.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -65,7 +65,7 @@

 ; -------------------------------------------------------------------

-(def curr-world (atom {})) ; { :world => world-actx
+(def prog-world (atom {})) ; { :world => world-actx
                            ;   :net-listen-ch => ch
                            ;   :net-connect-ch => ch }

@@ -159,7 +159,7 @@
                           ;         :first-taker-actx actx-or-nil}}.
                   :gen-id gen-id})
             render-ch (chan)]
-        (reset! curr-world {:world world
+        (reset! prog-world {:world world
                             :net-listen-ch (achan-buf world 10)
                             :net-connect-ch (achan-buf world 10)
                             :servers {}
@@ -168,13 +168,13 @@
                                  event-ch step-ch render-ch)
         (cbfg.vis/process-render el-prefix world render-ch nil)
         (make-net world
-                  (:net-listen-ch @curr-world)
-                  (:net-connect-ch @curr-world))
+                  (:net-listen-ch @prog-world)
+                  (:net-connect-ch @prog-world))
         (let [prog (get-el-value "prog")
               prog-js (str "with (cbfg.world.t1) {" prog "}")
               prog-res (try (js/eval prog-js) (catch js/Object ex ex))]
           (println :prog-res prog-res)
-          (println :curr-world @curr-world)
+          (println :prog-world @prog-world)
           (<! prog-ch)
           (close! event-ch)
           (close! render-ch)
@@ -191,27 +191,27 @@
 ; --------------------------------------------

 (defn kv-server [name & ports]
-  (let [world (:world @curr-world)
+  (let [world (:world @prog-world)
         done (atom false)]
     (act server-init world
          (doseq [port ports]
            (when-let [listen-result-ch (achan server-init)]
-             (aput server-init (:net-listen-ch @curr-world) [name port listen-result-ch])
+             (aput server-init (:net-listen-ch @prog-world) [name port listen-result-ch])
              (when-let [[accept-ch close-accept-ch] (atake server-init listen-result-ch)]
                (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch)
-               (swap! curr-world #(update-in % [:servers name] conj port)))))
+               (swap! prog-world #(update-in % [:servers name] conj port)))))
          (reset! done true))
     (wait-done done)))

 (defn kv-client [client-addr server-addr server-port]
-  (let [world (:world @curr-world)
+  (let [world (:world @prog-world)
         done (atom false)]
     (act client-init world
          (let [res-ch (achan client-init)
-               req-ch (cbfg.world.net/client-loop world (:net-connect-ch @curr-world)
+               req-ch (cbfg.world.net/client-loop world (:net-connect-ch @prog-world)
                                                   server-addr server-port
                                                   client-addr res-ch)]
-           (swap! curr-world #(assoc-in % [:clients client-addr]
+           (swap! prog-world #(assoc-in % [:clients client-addr]
                                         {:client-addr client-addr
                                          :server-addr server-addr
                                          :server-port server-port


Silly, but instructive fizz-buzz variant

--- src/shokunin/fizzbuzz.clj
+++ src/shokunin/fizzbuzz.clj
@@ -1,7 +1,14 @@
 (ns shokunin.fizzbuzz)

-(def fizz-buzz (let [number (iterate inc 1)
+(def fizz-buzz-seq (let [number (iterate inc 1)
                      fizzer (cycle [nil nil "fizz"])
                      buzzer (cycle [nil nil nil nil "buzz"])]
                  (map #(or (if (or %2 %3) (str %2 %3)) %1)
                       number fizzer buzzer)))
+
+(def fizz-buzz-fn
+  (some-fn #(and (= (rem % 3) 0) (= (mod % 5) 0) "FizzBuzz")
+           #(and (= (rem % 3) 0) "Fizz")
+           #(and (= (rem % 5) 0) "Buzz")))
+
+


refactored callback builder

refactored callback builder

--- examples/calendar/src/calendar_demo/core.cljs
+++ examples/calendar/src/calendar_demo/core.cljs
@@ -27,7 +27,7 @@

 (c/defscomponent Visualization
                  [data context]
-                 (let [cbb (cms/op-builder context)
+                 (let [cbb (qms/op-builder context)
                        refresh-data (fn []
                                       (js/setTimeout (cbb set-data) 500))]
                    (d/div {}


Need to check whether the peer is the joiner in the entry, not the diff Cannot use nth on hashset, use distinct instead

--- src/onyx/log/commands/prepare_join_cluster.clj
+++ src/onyx/log/commands/prepare_join_cluster.clj
@@ -34,7 +34,7 @@
   (let [all-prepared-deps (keys prepared)
         prep-watches (map (fn [dep] (get (map-invert pairs) dep)) all-prepared-deps)
         accepting-deps (keys accepted)]
-    (set (concat all-prepared-deps accepting-deps prep-watches))))
+    (concat all-prepared-deps accepting-deps prep-watches)))

 (s/defmethod extensions/apply-log-entry :prepare-join-cluster :- Replica
   [{:keys [args message-id]} :- LogEntry replica]
@@ -43,7 +43,7 @@
         n (count peers)]
     (if (> n 0)
       (let [all-joined-peers (set (into (keys (:pairs replica)) peers))
-            candidates (difference all-joined-peers (disallowed-candidates replica) #{joiner})
+            candidates (difference all-joined-peers (set (disallowed-candidates replica)) #{joiner})
             sorted-candidates (sort (remove nil? candidates))]
         (cond (already-joined? replica joiner)
               replica
@@ -104,15 +104,15 @@
          ;; and is rebooted. We pick a predictably-random peer
          ;; and knock it down if it's not up. This guarantees
          ;; progress even if the cluster has experiences total failure.
-         (and (= (:id state) (:subject diff)) (nil? diff))
-         (let [disallowed (disallowed-candidates new)
+         (and (= (:id state) (:joiner args)) (nil? diff))
+         (let [disallowed (distinct (disallowed-candidates new))
                k (mod message-id (count disallowed))
                target (nth disallowed k)]
            (when-not (extensions/peer-exists? log target)
              (extensions/write-log-entry
-              (:log state)
-              {:fn :leave-cluster :args {:id target}
-               :entry-parent message-id})))
+               (:log state)
+               {:fn :leave-cluster :args {:id target}
+                :entry-parent message-id})))

          (= (:id state) (:observer diff))
          (let [ch (chan 1)]


fixing keys path

fixing keys path

--- src/celestial/jobs.clj
+++ src/celestial/jobs.clj
@@ -35,7 +35,7 @@
   "Executes a job function tries to lock identity first (if used)"
   (let [{:keys [identity args tid] :as spec} message]
    (set-tid tid
-    (let [{:keys [wait-time expiry]} (map-vals (or (get* :job) defaults) #(* minute %) )]
+    (let [{:keys [wait-time expiry]} (map-vals (or (get* :celestial :job) defaults) #(* minute %) )]
       (try
        (if identity
          (do (with-lock (server-conn) identity wait-time expiry (apply f args)) {:status :success})


not found route

not found route

--- src/checkmate/core.clj
+++ src/checkmate/core.clj
@@ -75,7 +75,8 @@
   (GET "/edit/:id" [id] (views/main-template (new-list/render id)))
   (GET "/az" [] (views/main-template (overview/render (get-all-lists))))
   (GET "/" [] (views/main-template (views/landing-view)))
-  (route/resources "/"))
+  (route/resources "/")
+  (route/not-found "These are not the checklists you are looking for!"))

 (def handler (site app))


reset

reset

--- src/ci3/agent/core.clj
+++ src/ci3/agent/core.clj
@@ -139,9 +139,8 @@
   (sh/sh "rm" "-rf" "/workspace/repo")
   (let [{err :err exit :exit :as res} (sh/sh "git" "clone" (:url repo) "/workspace/repo")]
     (if (= 0 exit)
-      (let [_ (println (sh/sh "ls" "/workspace/repo"))
-            {err :err exit :exit :as res}
-            (sh/sh "cd" "/workspace/repo" "&&" "git" "reset" "--hard" (:hashcommit build))]
+      (let [{err :err exit :exit :as res}
+            (sh/sh "git" "reset" "--hard" (:hashcommit build) :dir "/workspace/repo")]
         (if-not (= 0 exit)
           {::u/status :error
            ::u/message err}


[#2837] Adapt subbucket-column bar chart to OPTION column type

--- backend/src/akvo/lumen/lib/aggregation/bar.clj
+++ backend/src/akvo/lumen/lib/aggregation/bar.clj
@@ -28,7 +28,7 @@
             (SELECT %1$s as x, %2$s as y, %7$s as s
              FROM %3$s
              WHERE %4$s
-             GROUP BY x, %7$s)
+             GROUP BY x, s)
           SELECT
             data_table.x AS x,
             data_table.y,
@@ -47,7 +47,7 @@
           filter-sql
           sort-sql
           truncate-size
-          (:columnName subbucket-column)))
+          (sql-option-bucket-column subbucket-column)))

 (defn- bucket-sql [table-name bucket-column aggregation filter-sql sort-sql truncate-size]
   (format "SELECT *


Show logo if set for corpus

Show logo if set for corpus

--- src/clj/cglossa/db.clj
+++ src/clj/cglossa/db.clj
@@ -92,7 +92,7 @@

 (defn get-corpus [code]
   (let [ress (sql-query (str "SELECT @rid as corpus_rid, name as corpus_name, "
-                             "has_phonetic, has_headword_search, "
+                             "logo, has_phonetic, has_headword_search, "
                              "$cats.@rid as cat_rids, $cats.code as cat_codes, "
                              "$cats.name as cat_names "
                              "FROM Corpus "
@@ -104,6 +104,7 @@
                    (update $ :cat_names (partial map vertex-name) (:cat_codes $)))]
     {:corpus              {:rid                 (:corpus_rid res)
                            :name                (:corpus_name res)
+                           :logo                (:logo res)
                            :has-phonetic        (:has_phonetic res)
                            :has-headword-search (:has_headword_search res)}
      :metadata-categories (-> (map (fn [rid name] {:rid rid :name name})


use a transaction for seed batches

use a transaction for seed batches

--- src/clj_money/seed.clj
+++ src/clj_money/seed.clj
@@ -2,6 +2,8 @@
   (:require [clojure.pprint :refer [pprint]]
             [environ.core :refer [env]]
             [clj-money.serialization :refer [realize]]
+            [clj-money.models.helpers :refer [with-storage
+                                              with-transacted-storage]]
             [clj-money.models.entities :as entities]
             [clj-money.models.users :as users]))

@@ -22,11 +24,11 @@

 (defn seed
   [user entity identifier]
-  (pprint
+  (with-transacted-storage [s (env :db)]
     (->> identifier
          (format "resources/seeds/%s.edn")
          slurp
          read-string
-         (append-user (env :db) user)
-         (append-entity (env :db) entity)
-         (realize (env :db)))))
+         (append-user s user)
+         (append-entity s entity)
+         (realize s))))


add exception check in db code

add exception check in db code

--- src/codestat/mysql.clj
+++ src/codestat/mysql.clj
@@ -89,9 +89,12 @@

 (defn insert-log
   [rec vcs_url branch]
-  (if-let [commit_id (:generated_key (insert-commit (:commit-rec rec) vcs_url branch))]
-    (doseq [r (:changeset-rec rec)]
-      (insert-changeset commit_id r))))
+  (try
+    (if-let [commit_id (:generated_key (insert-commit (:commit-rec rec) vcs_url branch))]
+      (doseq [r (:changeset-rec rec)]
+        (insert-changeset commit_id r)))
+    (catch Exception e
+      (println ">>> insert-log Exception:" (.getMessage e)))))

 ;;;
 ;;; insert a project


CMR-1436 Updates cmr.common.config.

CMR-1436 Updates cmr.common.config.

defconfig now allows for :default nil in its options. Various
state-holding vars are also now defined with defonce to persist state
values between reloads.

--- common-lib/src/cmr/common/config.clj
+++ common-lib/src/cmr/common/config.clj
@@ -6,8 +6,9 @@
             [clojure.set :as set]
             [cmr.common.log :as log :refer (debug info warn error)]))

-(def ^:private runtime-config-values
-  "An atom containing a map of explicitly set config values."
+(defonce ^{:private true
+           :doc "An atom containing a map of explicitly set config values."}
+  runtime-config-values
   (atom {}))

 (defn set-config-value!
@@ -68,10 +69,12 @@
            env-value
            parsed-default)))))

-(def configs-atom
-  "This contains information about all of the configuration parameters that have been added using
-  defconfig. It is used for allowing documentation generation of configuration parameters. It's a map
-  of namespaces to configuration keys to options maps."
+(defonce ^{:doc "This contains information about all of the
+                 configuration parameters that have been added using
+                 defconfig. It is used for allowing documentation
+                 generation of configuration parameters. It's a map of
+                 namespaces to configuration keys to options maps."}
+  configs-atom
   (atom {}))

 (defn register-config
@@ -160,9 +163,9 @@
                       (resolve config-type)
                       String)]
     (when-not doc-string
-      (throw (Exception. "defconfig doc-string is required")))
-    (when (nil? default)
-      (throw (Exception. "defconfig default is required")))
+      (throw (Exception. "defconfig :doc-string is required")))
+    (when (not (contains? options :default))
+      (throw (Exception. "defconfig :default is required")))
     (when (and (nil? parser) config-type (nil? (type->parser config-type)))
       (throw (Exception. (str "Unrecognized defconfig type: " config-type))))


FIx swagger uris

FIx swagger uris

--- modules/reitit-swagger/src/reitit/swagger.cljc
+++ modules/reitit-swagger/src/reitit/swagger.cljc
@@ -68,7 +68,8 @@
   (->> (impl/segments path)
        (map #(if (impl/wild-or-catch-all-param? %)
                (str "{" (subs % 1) "}") %))
-       (str/join "/")))
+       (str/join "/")
+       (str "/")))

 (defn create-swagger-handler []
   "Create a ring handler to emit swagger spec. Collects all routes from router which have


Add task to automatically recompile source.

Add task to automatically recompile ClojureScript source code.

--- modern-cljs/src/cljs/modern_cljs/core.cljs
+++ modern-cljs/src/cljs/modern_cljs/core.cljs
@@ -5,4 +5,4 @@
 (enable-console-print!)

 ;; print a friendly greeting to the console
-(println "Hello, Modern ClojureScript World!")
+(println "Hello, New, Modern ClojureScript World!")


handle selecting arrows with bbox (slow, but works)

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -334,6 +334,12 @@
     (assoc-in [:drawing :layers 0 :layer/text] value)
     (assoc-in [:drawing :layers 0 :bbox] bbox)))

+(defn det [[ax ay] [bx by] [x y]]
+  (math/sign (- (* (- bx ax)
+                   (- y ay))
+                (* (- by ay)
+                   (- x ax)))))
+
 (defn eids-in-bounding-box [db {:keys [start-x end-x start-y end-y] :as box}]
   (let [x0 (min start-x end-x)
         x1 (max start-x end-x)
@@ -375,12 +381,7 @@
                                 above-y0-end-e)

                      (set/union below-y1-start-e
-                                below-y1-end-e))
-        det (fn [[ax ay] [bx by] [x y]]
-              (math/sign (- (* (- bx ax)
-                               (- y ay))
-                            (* (- by ay)
-                               (- x ax)))))]
+                                below-y1-end-e))]
     (set (filter (fn [eid]
                    ;; TODO: optimize by looking up start-x, end-x, etc. from the index ranges
                    ;;       we've already created
@@ -463,6 +464,37 @@
     (set/difference candidates
                     rejects)))

+(defn arrows-in-bounding-box [db {:keys [start-x end-x start-y end-y]}]
+  (let [x0 (min start-x end-x)
+        x1 (max start-x end-x)
+        y0 (min start-y end-y)
+        y1 (max start-y end-y)]
+    (reduce (fn [acc d]
+              (let [origin (d/entity db (:e d))
+                    dest (d/entity db (:v d))
+                    origin-center (layers/center origin)
+                    dest-center (layers/center dest)
+                    [ox oy] (layers/layer-intercept origin dest-center)
+                    [dx dy] (layers/layer-intercept dest origin-center)]
+                (if (or
+                     ;; has endpoint
+                     (and (< x0 ox x1)
+                          (< y0 oy y1))
+                     ;; has endpoint
+                     (and (< x0 dx x1)
+                          (< y0 dy y1))
+
+                     (and
+                      (> (max ox dx) x0)
+                      (< (min ox dx) x1)
+                      (> (max oy dy) y0)
+                      (< (min oy dy) y1)
+                      (not= 4 (Math/abs (reduce + (map (partial det [ox oy] [dx dy])
+                                                       [[x0 y0] [x0 y1] [x1 y0] [x1 y1]]))))))
+                  (conj acc {:origin-id (:e d) :dest-id (:v d)})
+                  acc)))
+            #{} (d/datoms db :aevt :layer/points-to))))
+
 (defn draw-in-progress-drawing [state x y {:keys [force-even? delta]}]
   (let [[rx ry] (cameras/screen->point (:camera state) x y)
         [snap-x snap-y] (cameras/snap-to-grid (:camera state) rx ry)
@@ -475,40 +507,46 @@
                                               {:start-x (get-in state [:drawing :layers 0 :layer/start-x])
                                                :end-x snap-x
                                                :start-y (get-in state [:drawing :layers 0 :layer/start-y])
-                                               :end-y snap-y}))]
-    (-> state
-        (update-in [:drawing :layers 0] #(-> %
-                                             (assoc :points points
-                                                    :force-even? force-even?
-                                                    :layer/current-x snap-x
-                                                    :layer/current-y snap-y)
-                                             (cond-> (and (= tool :text)
-                                                          (get-in state [:mouse-down]))
-                                               ((fn [s]
-                                                  (let [zoom (get-in state [:camera :zf])]
-                                                    (-> s
-                                                      (update-in [:layer/start-x] + (* (/ 1 zoom)
-                                                                                (:x delta)))
-                                                      (update-in [:layer/start-y] + (* (/ 1 zoom)
-                                                                                (:y delta))))))))))
-        (update-in [:drawing :layers 0]
-                   (fn [layer]
-                     (merge
-                      layer
-                      (when (= :pen tool)
-                        {:layer/path (svg/points->path points)})
-                      (when (or (= :circle tool)
-                                ;; TODO: hack to preserve border-radius for re-editing circles
-                                (layers/circle? layer))
-                        {:layer/rx (js/Math.abs (- (:layer/start-x layer)
-                                                   (:layer/current-x layer)))
-                         :layer/ry (js/Math.abs (- (:layer/start-y layer)
-                                                   (:layer/current-y layer)))})
-                      (when (seq bounding-eids)
-                        {:layer/child bounding-eids}))))
-        (assoc-in [:editing-eids :editing-eids] #{(get-in state [:drawing :layers 0 :db/id])})
-        (cond-> group?
-          (assoc-in [:selected-eids :selected-eids] (set bounding-eids))))))
+                                               :end-y snap-y}))
+        bounding-arrows (when group?
+                          (arrows-in-bounding-box @(:db state)
+                                                  {:start-x (get-in state [:drawing :layers 0 :layer/start-x])
+                                                   :end-x snap-x
+                                                   :start-y (get-in state [:drawing :layers 0 :layer/start-y])
+                                                   :end-y snap-y}))]
+    (-> state
+      (update-in [:drawing :layers 0] #(-> %
+                                         (assoc :points points
+                                                :force-even? force-even?
+                                                :layer/current-x snap-x
+                                                :layer/current-y snap-y)
+                                         (cond-> (and (= tool :text)
+                                                      (get-in state [:mouse-down]))
+                                           ((fn [s]
+                                              (let [zoom (get-in state [:camera :zf])]
+                                                (-> s
+                                                  (update-in [:layer/start-x] + (* (/ 1 zoom)
+                                                                                (:x delta)))
+                                                  (update-in [:layer/start-y] + (* (/ 1 zoom)
+                                                                                (:y delta))))))))))
+      (update-in [:drawing :layers 0]
+                 (fn [layer]
+                   (merge
+                    layer
+                    (when (= :pen tool)
+                      {:layer/path (svg/points->path points)})
+                    (when (or (= :circle tool)
+                              ;; TODO: hack to preserve border-radius for re-editing circles
+                              (layers/circle? layer))
+                      {:layer/rx (js/Math.abs (- (:layer/start-x layer)
+                                                 (:layer/current-x layer)))
+                       :layer/ry (js/Math.abs (- (:layer/start-y layer)
+                                                 (:layer/current-y layer)))})
+                    (when (seq bounding-eids)
+                      {:layer/child bounding-eids}))))
+      (assoc-in [:editing-eids :editing-eids] #{(get-in state [:drawing :layers 0 :db/id])})
+      (cond-> group? (assoc-in [:selected-eids :selected-eids] (set bounding-eids))
+              group? (assoc-in [:selected-arrows :selected-arrows] (set bounding-arrows))))))

 (defn move-points [points move-x move-y]
   (map (fn [{:keys [rx ry]}]


Added search for default video folder

Added search for default video folder

--- src/video_server/main.clj
+++ src/video_server/main.clj
@@ -26,8 +26,19 @@

 (def discovery-port 8394)

-(defn default-folder []
-  (str (System/getProperty "user.home") "/Movies"))
+(defn exists?
+  "Returns the canonical path if the directory exists."
+  [home dir]
+  (let [path (io/file home dir)]
+    (when (.isDirectory path) (.getCanonicalPath path))))
+
+(defn default-folder
+  "Returns the default folder from which to serve videos by searching
+  for commonly named directories in the user home directory."
+  []
+  (let [home (System/getProperty "user.home")]
+    (or (some (partial exists? home) ["Videos" "Movies" "My Videos"])
+        (.getCanonicalPath (io/file home "Videos")))))

 (defn host-url
   "Returns a url for this web server based on the IP address and web port."


rename

rename

--- src/hogwarts/core.clj
+++ src/hogwarts/core.clj
@@ -1,4 +1,4 @@
-(ns lightbringer.core
+(ns hogwarts.core
   (:use ring.adapter.jetty
         ring.util.response
         lightbringer.view)


change message formatting

change message formatting

--- src/io/perun/core.clj
+++ src/io/perun/core.clj
@@ -43,7 +43,7 @@
         (str
           (ansi/yellow (str "[" task "]"))
           " - "
-          (ansi/green (str "[" msg "]\n")))
+          (ansi/green (str msg "\n")))
         args))

 (defn report-debug [task msg datastructure]
@@ -51,7 +51,7 @@
     (str
       (ansi/yellow (str "[" task "]"))
       " - "
-      (ansi/blue (str "[" msg "]\n"))
+      (ansi/blue (str msg "\n"))
       "%s\n")
     (pr-str datastructure)))

@@ -92,8 +92,8 @@

 (defn parent-path [filepath filename-with-extension]
   (if (.endsWith filepath filename-with-extension)
-       (.substring filepath 0 (- (count filepath)
-                          (count filename-with-extension)))
+      (.substring filepath 0 (- (count filepath)
+                              (count filename-with-extension)))
      filepath))

 (defn ^String extension [name]


Log the exception, for debugging

Log the exception, for debugging

--- src/circle/backend/action/load_balancer.clj
+++ src/circle/backend/action/load_balancer.clj
@@ -1,7 +1,7 @@
 (ns circle.backend.action.load-balancer
   (:import com.amazonaws.AmazonClientException)
   (:require [clj-http.client :as http])
-  (:use [clojure.tools.logging :only (infof)])
+  (:use [clojure.tools.logging :only (infof errorf)])
   (:use [circle.backend.action :only (defaction abort!)])
   (:use [circle.util.except :only (throw-if-not)])
   (:require [clj-time.core :as time])
@@ -52,6 +52,7 @@
          #(lb/healthy? lb-name instance-ids))
         (build-log "instances %s all healthy in load balancer %s" instance-ids lb-name)
         (catch Exception e
+          (errorf e "wait-for-healthy: caught e" (.getClass e))
           (abort! build (format "load balancer didn't report healthy for %s" instance-ids)))))))

 (defn get-old-revisions


Slightly adjust the trolley preview starting y position

--- src/cljs/ikea_clojure_cup/select_items.cljs
+++ src/cljs/ikea_clojure_cup/select_items.cljs
@@ -176,7 +176,7 @@
                                 :width width
                                 :fill :transparent}])
                 (update :offset + (* scale 2) height))))
-        {:offset 0 :rects nil}
+        {:offset 4 :rects nil}
         packages))]]))

 (defn select-items-view


Update rem-tabset def to remove compiler warning

--- src/lt/objs/tabs.cljs
+++ src/lt/objs/tabs.cljs
@@ -460,26 +460,21 @@
   ;(object/raise ts :active)
   )

-(defn rem-tabset [ts prev?]
-  (let [to-ts (if prev?
-                (or (prev-tabset ts) (next-tabset ts))
-                (or (next-tabset ts) (prev-tabset ts)))]
-    (when to-ts
-      (object/merge! to-ts {:width (floored (+ (:width @to-ts) (:width @ts)))})
-      (dom/remove (object/->content ts))
-      (doseq [t (:objs @ts)]
-        (add! t to-ts))
-      (object/update! multi [:tabsets] #(vec (remove #{ts} %)))
-      (object/destroy! ts)
-      (equalize-tabset-widths)
-      (object/raise to-ts :active))))
-
-(defn menu! [obj ev]
-  (-> (menu/menu [{:label "Move tab to new tabset"
-                   :click (fn [] (cmd/exec! :tabs.move-new-tabset obj))}
-                  {:label "Close tab"
-                   :click (fn [] (object/raise obj :close))}])
-      (menu/show-menu (.-clientX ev) (.-clientY ev))))
+(defn rem-tabset
+  ([ts] (rem-tabset ts false))
+  ([ts prev?]
+   (let [to-ts (if prev?
+                 (or (prev-tabset ts) (next-tabset ts))
+                 (or (next-tabset ts) (prev-tabset ts)))]
+     (when to-ts
+       (object/merge! to-ts {:width (floored (+ (:width @to-ts) (:width @ts)))})
+       (dom/remove (object/->content ts))
+       (doseq [t (:objs @ts)]
+         (add! t to-ts))
+       (object/update! multi [:tabsets] #(vec (remove #{ts} %)))
+       (object/destroy! ts)
+       (equalize-tabset-widths)
+       (object/raise to-ts :active)))))

 (defn rem! [obj]
   (when (and obj @obj (::tabset @obj))


Authenticating a user - two sample handlers

--- src/meetdown/http.clj
+++ src/meetdown/http.clj
@@ -9,18 +9,41 @@
             [ring.middleware.defaults :as rmd]
             [meetdown.data :as data]
             [org.httpkit.server :refer [run-server]]
-            [taoensso.timbre :as timbre]))
+            [taoensso.timbre :as timbre]
+            [meetdown.auth :as auth]))

 (defn- handle-query
   [db-conn]
-  (fn [{req-body :body-params}]
+  (fn [{req-body :body-params, :keys [user-roles user-id]}]
     (let [db (data/database db-conn)]
       (case (:type req-body)
         :get-events   {:body (data/get-events db)}
+
         :create-event {:body {:db/id (:db/id (data/create-entity db-conn (:txn-data req-body)))}}
+
         :get-event    {:body (->> (get-in req-body [:txn-data :db/id])
                                   (data/to-ent db))}
+
         :create-user  {:body {:db/id (:db/id (data/create-entity db-conn (:txn-data req-body)))}}
+
+
+        ;; Auth: test with:
+        ;; curl -iXPOST http://localhost:3000/q -d "{:type :login, :user-id "james"}" -H "Content-Type: application/edn"
+
+        ;; curl -iXPOST http://localhost:3000/q -d "{:type :get-current-user}" -H "Content-Type: application/edn" -H "Authorization: <token>"
+
+        :get-current-user (if user-id
+                            {:body {:user-id user-id
+                                    :user-roles user-roles}}
+                            {:body :no-current-user
+                             :status 401})
+
+        ;; yes, we log *anyone* in...
+        :login {:body :logged-in
+                :headers {"Authorization" (auth/generate-token {:user-id (:user-id req-body)
+                                                                :user-roles #{:admin}})}}
+
+
         {:status 415 :body (str "Unsupported type - " (:type req-body))}))))

 (def home-page
@@ -41,10 +64,10 @@

 (defn make-router [db-conn]
   (routes
-   (resources "/")
-   (GET "/" [] home-page)
-   (POST "/q" []
-         (handle-query db-conn))))
+    (resources "/")
+    (GET "/" [] home-page)
+    (POST "/q" []
+      (handle-query db-conn))))

 (def default-config
   {:params {:urlencoded true
@@ -62,10 +85,18 @@
       (timbre/debug "Handling request:" req)
       (handler req))))

+(defn wrap-authenticate-user
+  [handler]
+
+  (fn [req]
+    (handler (merge req
+                    (auth/authenticate-user (get-in req [:headers "authorization"]))))))
+
 (defn make-handler [db-conn]
   (-> (make-router db-conn)
-      (wrap-log-request)
+      wrap-log-request
       (wrap-restful-format :formats [:edn :transit-json])
+      wrap-authenticate-user
       (rmd/wrap-defaults rmd/api-defaults)))


update joined stage argument type

update joined stage argument type

--- src/papaline/core.clj
+++ src/papaline/core.clj
@@ -60,7 +60,7 @@
                                 (let [fork-rets (swap! (last (:fork-rets ctx)) conj @(:args ctx))]
                                   (when (= (last (:forks ctx)) (count fork-rets))
                                     (>! out-chan (assoc ctx
-                                                   :args [fork-rets]
+                                                   :args fork-rets
                                                    :forks (vec (drop-last (:forks ctx)))
                                                    :fork-rets (vec (drop-last (:fork-rets ctx)))))))


(feat) thread pool name

(feat) thread pool name

--- src/papaline/core.clj
+++ src/papaline/core.clj
@@ -6,7 +6,7 @@
             [papaline.util :refer [defprotocol+ defrecord+]])
   (:import [java.util.concurrent ExecutorService TimeUnit TimeoutException
             ThreadPoolExecutor LinkedBlockingQueue RejectedExecutionHandler
-            ThreadPoolExecutor$DiscardOldestPolicy]))
+            ThreadPoolExecutor$DiscardOldestPolicy ThreadFactory]))

 (defrecord Stage [buffer-factory stage-fn]
   clojure.lang.IFn
@@ -201,11 +201,22 @@
 (defn cancel-pipeline [pipeline]
   (stop! pipeline))

+(defn counted-thread-factory
+  [name-format daemon]
+  (let [counter (atom 0)]
+    (reify
+      ThreadFactory
+      (newThread [this runnable]
+        (doto (Thread. runnable)
+          (.setName (format name-format (swap! counter inc)))
+          (.setDaemon daemon))))))
+
 (defn make-thread-pool [threads queue-size & {:keys [overflow-action]
                                               :or {overflow-action (ThreadPoolExecutor$DiscardOldestPolicy.)}}]
   (ThreadPoolExecutor. (int threads) (int threads) (long 0)
                        TimeUnit/MILLISECONDS
                        (LinkedBlockingQueue. queue-size)
+                       (counted-thread-factory "papaline-pool-%d" true)
                        ^RejectedExecutionHandler overflow-action))

 (defn dedicated-thread-pool-pipeline [stages thread-pool & {:keys [error-handler]}]


publish blog post

publish blog post

--- src/pc/views/blog.clj
+++ src/pc/views/blog.clj
@@ -43,7 +43,8 @@
   [
    {:slug "ideas-are-made-with-precursor"
     :unique-id "ideas-are-made-with-precursor"
-    :display-in-overview false}
+    :display-in-overview true
+    :pub-date (clj-time.format/parse "Tue, 31 Mar 2015 09:00:00 -0800")}
    {:slug "clojure-is-a-product-design-tool"
     :unique-id "clojure-is-a-product-design-tool"
     :display-in-overview true


fix logo icon in blog

fix logo icon in blog


Poll: Check for changed data *before* waiting for poll-messages.

--- src/pepa/web/poll.clj
+++ src/pepa/web/poll.clj
@@ -45,27 +45,26 @@
         timeout (async/timeout (* 1000 (:timeout config)))
         bus-changes (bus/subscribe-all bus (async/sliding-buffer 1))]
     (go-loop []
-      ;; NOTE: We have to manually close the channels after a timeout,
-      ;; else they stay open for forever & hog memory!
-      (let [[val port] (async/alts! [timeout bus-changes])]
-        (cond
-          (= port bus-changes)
-          (let [topic (bus/topic val)]
-            (lock! db topic)
-            (if-let [changed (m/changed-entities db seqs)]
-              (do
-                (println "changed" (pr-str changed))
-                (send! ch changed))
-              (do
-                (println "nothing changed")
-               (recur))))
-          (= port timeout)
-          (do
-            (println "Closing long-polling channel after timeout")
-            (async-web/close ch))
-
-          ;; (println "handle-poll loop" "port:" (if (= timeout port) "timeout" "bus-changes") "val:"(pr-str val))
-          )))))
+      (if-let [changed (m/changed-entities db seqs)]
+        (do
+          (println "changed" (pr-str changed))
+          (send! ch changed))
+        ;; NOTE: We have to manually close the channels after a timeout,
+        ;; else they stay open for forever & hog memory!
+        (let [[val port] (async/alts! [timeout bus-changes])]
+          (cond
+            ;; Something changed
+            (= port bus-changes)
+            (let [topic (bus/topic val)]
+              (lock! db topic)
+              ;; Recur to trigger the then-part of the if.
+              (recur))
+            ;; Hit a timeout or channel is closed
+            (or (= port timeout) (not (async-web/open? ch)))
+            (do
+              (println "Closing long-polling channel...")
+              (when (async-web/open? ch)
+                (async-web/close ch)))))))))

 (defn ^:private poll-handler* [req]
   (let [method (:request-method req)


Make playhead move faster

Make playhead move faster

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -114,7 +114,7 @@
                                                  scale))
      :notes ()
      :w 0 :h 0 :sound-ready false
-     :px-per-ms 0.04
+     :px-per-ms 0.1
      :cur-touches {}
      :scrolling? false
      :start start


slack : cast event :tags into vector (#749)

--- src/riemann/slack.clj
+++ src/riemann/slack.clj
@@ -35,7 +35,7 @@
                      "State:   " (or (:state events) "-") "\n"
                      "Description:   " (or (:description events) "-") "\n"
                      "Metric:   " (or (:metric events) "-") "\n"
-                     "Tags:   " (or (:tags events) "-") "\n"))
+                     "Tags:   " (into [] (:tags events)) "\n"))
        :short true}]}]})

@@ -64,7 +64,7 @@
        :value (slack-escape (or (:description events) "-"))
        :short true}
       {:title "Tags",
-       :value (slack-escape (or (str (:tags events)) "-"))
+       :value (slack-escape (str (into [] (:tags events))))
        :short true}]}]})


removing println

removing println

--- src/routings/core.clj
+++ src/routings/core.clj
@@ -241,7 +241,6 @@
     (build-static-processor
       static
       (fn [req]
-        (println req)
         (try
           (let [path (split-path (:uri req))
                 route (get-route routing path (method req) (:headers req))]


Lifecycle is inside a future.

Lifecycle is inside a future.

--- src/onyx/log/commands/volunteer_for_task.clj
+++ src/onyx/log/commands/volunteer_for_task.clj
@@ -171,7 +171,7 @@
            (or (not= (:job state) (:job diff))
                (not= (:task state) (:task diff))))
     (do (when (:lifecycle state)
-          (component/stop (:lifecycle state)))
+          (component/stop @(:lifecycle state)))
         (let [seal-ch (chan)
               new-state (assoc state :job (:job diff) :task (:task diff) :seal-ch seal-ch)
               new-lifecycle (future (component/start ((:task-lifecycle-fn state) diff new-state)))]


Updated asset uri transformation fn.

Updated asset uri transformation fn.

--- src/timber/assets.clj
+++ src/timber/assets.clj
@@ -3,10 +3,12 @@

 (defn- new-uri-from-match
   [public-uri match uri-attr]
-  (println public-uri)
-  (println match)
-  (println uri-attr)
-  (conj public-uri (vec (rest (h-uri/path (get-in match [:attrs uri-attr]))))))
+    (conj public-uri
+          (second
+            (h-uri/path-divergance
+              public-uri
+              (h-uri/path
+                (vec (rest (get-in match [:attrs uri-attr]))))))))

 (defn transform-link
   "Creates an enlive transformation fn that re-writes link asset URIs."


accounts: add a random status to a recovered account #637

--- src/status_im/accounts/recover/handlers.cljs
+++ src/status_im/accounts/recover/handlers.cljs
@@ -5,6 +5,7 @@
             [status-im.utils.identicon :refer [identicon]]
             [taoensso.timbre :as log]
             [clojure.string :as str]
+            [status-im.accounts.statuses :as statuses]
             [status-im.utils.handlers :as u]
             [status-im.utils.gfycat.core :refer [generate-gfy]]
             [status-im.protocol.core :as protocol]))
@@ -18,6 +19,7 @@
         account    {:public-key          public-key
                     :address             address
                     :name                (generate-gfy)
+                    :status              (rand-nth statuses/data)
                     :photo-path          (identicon public-key)
                     :updates-public-key  public
                     :updates-private-key private


Remove unused or.

Remove unused or.

--- src/oc/storage/representations/activity.clj
+++ src/oc/storage/representations/activity.clj
@@ -22,6 +22,7 @@
   ([collection-type {slug :slug} sort-type]
   (let [sort-path (when (= sort-type :recent-activity) "?sort=activity")]
     (str "/orgs/" slug "/" collection-type sort-path)))
+
   ([collection-type {slug :slug :as org} sort-type {start :start direction :direction}]
   (let [concat-str (if (= sort-type :recent-activity) "&" "?")]
     (str (url collection-type org sort-type) concat-str "start=" start (when direction (str "&direction=" (name direction)))))))
@@ -35,7 +36,7 @@
   (let [activity (:activity data)
         activity? (not-empty activity)
         last-activity (last activity)
-        last-activity-date (when activity? (or (:last-activity-at last-activity) (:last-activity-at last-activity)))
+        last-activity-date (when activity? (:last-activity-at last-activity))
         next? (= (:next-count data) config/default-activity-limit)
         next-url (when next?
                    (if (is-inbox? collection-type)


Remove tests for specific error messages

Even though that was the point of the previous commit, I don't want to
declare that any specific error message string is part of the public
API. Only the type of the exception is specified.

--- src/test/clojure/clojure/data/json_test.clj
+++ src/test/clojure/clojure/data/json_test.clj
@@ -238,11 +238,11 @@
   (is (thrown? java.io.EOFException (json/read-str ""))))

 (deftest throws-eof-in-unterminated-array
-  (is (thrown-with-msg? java.io.EOFException #"end-of-file inside array"
+  (is (thrown? java.io.EOFException
         (json/read-str "[1, "))))

 (deftest throws-eof-in-unterminated-string
-  (is (thrown-with-msg? java.io.EOFException #"end-of-file inside string"
+  (is (thrown? java.io.EOFException
         (json/read-str "\"missing end quote"))))

 (deftest accept-eof