[new video player - not yet visible - work in progress]

--- src/prais2/components/video_player.cljc
+++ src/prais2/components/video_player.cljc
@@ -5,39 +5,34 @@
   {
    :did-mount (fn [state]
                 #?(:cljs (do (.videojs js/window "video1"
-                                       (clj->js {:playbackRates [1 1.5 2]})
-                                       #(prn "video-1 initialised"))
-                             (.videojs js/window "video2"
-                                       (clj->js {:playbackRates [1 1.5 2]})
-                                       #(prn "video-2 initialised"))))
+                                       (clj->js {} #_{:playbackRates [1 1.5 2]})
+                                       #(prn "video-1 initialised"))))
                 state)
+   :should-update  (fn [_ _] false)
    })

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

-                  [:video.video-js.vjs-default-skin
+                  [:video.video-js.vjs-default-skin.vjs-big-play-centered
                    {:key      1
                     :id       video-id
                     :poster   poster
                     :controls controls
                     :preload  preload
-                    :style    {;:padding-bottom   "30px"
-                               ;:padding-left "30px"
-                               ;:padding-right "30px"
-                               :background-color "rgba(255,255, 255, 0)"
+                    :style    {:background-color "rgba(255,255, 255, 0)"
                                :max-width "600px"
-                               :width "100%"
-                               :height "100%"}}
+                               :width "480px"
+                               :height "272px"}}
                    [:source {:key  1
                              :src  src
                              :type "video/mp4"}]
-                   [:track {:key     2
+                   #_[:track {:key     2
                             :src     track-src
-                            :label   "subtitles on"
+                            :label   "captions-on"
                             :kind    "captions"
                             :srclang "en"}]]]))


(PDB-2789) drop index on certnames(latest_report_id)

This reverts us back to the exact table schema used in burnside by removing an
index on certnames that made certain console queries against /nodes slow.

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1028,6 +1028,11 @@
   []
   (jdbc/do-commands
     "CREATE INDEX idx_certnames_latest_report_id on certnames(latest_report_id)"))
+
+(defn drop-certnames-latest-id-index
+  []
+  (jdbc/do-commands
+    "DROP INDEX idx_certnames_latest_report_id"))

 (def migrations
   "The available migrations, as a map from migration version to migration function."
@@ -1051,7 +1056,8 @@
    42 add-support-for-historical-catalogs
    43 add-indexes-for-reports-summary-query
    44 add-catalog-uuid-to-reports-and-catalogs
-   45 index-certnames-latest-report-id})
+   45 index-certnames-latest-report-id
+   46 drop-certnames-latest-id-index})

 (def desired-schema-version (apply max (keys migrations)))


(PDB-5484) insert-packages: remove unused new-package-ids

Looks like the value was never used.

cf. 15f95c879dd7002c236d43b255d060ae54b68ce3

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -1094,8 +1094,7 @@
         just-hashes (map pkg-util/package-tuple-hash hashed-package-tuples)
         existing-package-hashes (find-package-hashes just-hashes)
         ;; a map of package hash to id in the packages table
-        full-hashes-map (insert-missing-packages existing-package-hashes hashed-package-tuples)
-        new-package-ids (vals full-hashes-map)]
+        full-hashes-map (insert-missing-packages existing-package-hashes hashed-package-tuples)]

     (jdbc/update! :certnames
                   {:package_hash (sutils/munge-hash-for-storage new-packageset-hash)}


(PDB-4903) Remove vestigial fact gc comment

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -65,12 +65,6 @@
    :title String})

 (def json-primitive-schema (s/cond-pre String Number Boolean))
-
-;; the maximum number of parameters pl-jdbc will admit in a prepared statement
-;; is 32767. delete-pending-value-id-orphans will create a prepared statement
-;; with 5 times the number of invalidated values, so 6000 here keeps us under
-;; that and leaves some room.
-(def gc-chunksize 6000)

 (def resource-schema
   (merge resource-ref-schema


Proper parameters are passed to all read-and-parse functions

--- src/emender_jenkins/metadata_reader.clj
+++ src/emender_jenkins/metadata_reader.clj
@@ -53,51 +53,51 @@
            :missing (-> (second lines) parse-int)}))

 (defn read-and-parse-docbook-versions
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-entities-count
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-entities-uniq
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-other-parts-count
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-program-listing
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-tag-frequencies
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-tags-with-conditions-count
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-tags-with-conditions-list
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-used-graphics-count
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-word-count
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-xincludes-count
-    []
+    [jenkins-url job-name]
 )

 (defn read-and-parse-zpage-count
-    []
+    [jenkins-url job-name]
 )

 (defn job-results->job-names


some cleanup

some cleanup

--- src/cljs/outliner/components/index.cljs
+++ src/cljs/outliner/components/index.cljs
@@ -9,6 +9,91 @@
    [om-tools.dom :as dom :include-macros true]
    ))

+
+
+(def root-path root-node)
+
+
+(defn listen [el type]
+  (let [out (chan)]
+    (events/listen el type (fn [e]
+                             ; ahh.. haxx
+                             (when (or (= (.-keyCode e) 8)
+                                       (= (.-keyCode e) 9))
+                               (.preventDefault e))
+                             (put! out e)))
+    out))
+
+(defn get-indexless [current-path]
+  (subvec current-path 0 (dec (count current-path))))
+
+(defn get-parent [current-path] (subvec current-path 0 (- (count current-path) 2)))
+
+(defn remove-node-from-parent [parent-children current-child-idx]
+  (vec (concat (subvec parent-children 0 current-child-idx)
+               (subvec parent-children (inc current-child-idx)))))
+
+(def keyevent->command
+  {; cursor movement ---------------------------
+   [37]        :cursor-left      ;left
+   [38]        :cursor-up        ;up
+   [39]        :cursor-right     ;right
+   [40]        :cursor-down      ;down
+   ; node movement -----------------------------
+   [38 :alt]   :node-up          ;alt-up
+   [40 :alt]   :node-down        ;alt-down
+   [9]         :right-shift-node ;tab
+   [39 :alt]   :right-shift-node ;alt-right
+   [9  :shift] :left-shift-node  ;shift-tab
+   [37 :alt]   :left-shift-node  ;alt-left
+   ; delete ------------------------------------
+   [8]         :destroy-node     ;bkspace
+   ; visibility of children --------------------
+   [32]        :toggle-collapse  ;space
+   })
+
+(defn prev-depth-path [parent-path body]
+  (loop [p parent-path]
+    (let [current (get-in body p)
+          children (:children current)]
+      (if (empty? children) p
+          (recur (conj p :children (dec (count children))))))))
+
+
+(defn gen-left-path [current-child-idx parent-path
+                     up-path data]
+    (cond
+        ; 0th sibling? -> parent
+        (zero? current-child-idx) parent-path
+        ; else, deepest of parent sibling recursively
+        :else (prev-depth-path up-path @data)
+        ))
+
+(defn next-depth-path [parent-path body]
+  (loop [p parent-path]
+    (let [current-p-idx  (last p)
+          maybe-new-p    (conj (get-indexless p) (inc current-p-idx))
+          maybe-new-node (get-in body maybe-new-p false)
+          ]
+      (cond
+       ; at the root node -> bottomed out..
+       (= root-node p) false
+       ; found a new node -> return it
+       maybe-new-node maybe-new-p
+       ; else, try again a level up
+       :else (recur (get-parent p))))))
+
+(defn gen-right-path [current-path current current-child-idx
+                      parent-path parent-children
+                      down-path
+                      data]
+  (cond
+   ; current node has children? -> first child
+   (not (empty? (:children current))) (conj current-path :children 0)
+   ; not max sibling? -> go to next sibling
+   (and parent-children (< current-child-idx (dec (count parent-children)))) down-path
+   ; else, find next depth wise.
+   :else (or (next-depth-path parent-path @data) current-path)))

 (defcomponent outline-head [head owner]
   (render [_]
@@ -36,81 +121,15 @@
                   (om/build-all outline-body (:children node) {:state state}))
                  )))

-(defn listen [el type]
-  (let [out (chan)]
-    (events/listen el type (fn [e]
-                             ; ahh.. haxx
-                             (when (= (.-keyCode e) 8) (.preventDefault e))
-                             (put! out e)))
-    out))
-
-(defn get-indexless [current-path]
-  (subvec current-path 0 (dec (count current-path))))
-
-(defn get-parent [current-path] (subvec current-path 0 (- (count current-path) 2)))
-
-(def keyevent->command
-  ; takes keycode, shift / alt / ctrl-state
-  ; returns action
-  {[37] :cursor-left
-   [38] :cursor-up
-   [39] :cursor-right
-   [40] :cursor-down
-   [38 :alt] :node-up
-   [40 :alt] :node-down
-   [8] :destroy-node
-   })
-
-(defn prev-depth-path [parent-path body]
-  (loop [p parent-path]
-    (let [current (get-in body p)
-          children (:children current)]
-      (if (empty? children) p
-          (recur (conj p :children (dec (count children))))))))
-
-
-(defn gen-left-path [current-child-idx parent-path
-                     up-path data]
-    (cond
-        ; 0th sibling? -> parent
-        (zero? current-child-idx) parent-path
-        ; else, deepest of parent sibling recursively
-        :else (prev-depth-path up-path @data)
-        ))
-
-(defn next-depth-path [parent-path body]
-  (loop [p parent-path]
-    (let [current-p-idx  (last p)
-          maybe-new-p    (conj (get-indexless p) (inc current-p-idx))
-          maybe-new-node (get-in body maybe-new-p false)
-          ]
-      (cond
-       ; at the root node -> bottomed out..
-       (= [:body 0] p) false
-       ; found a new node -> return it
-       maybe-new-node maybe-new-p
-       ; else, try again a level up
-       :else (recur (get-parent p))))))
-
-(defn gen-right-path [current-path current current-child-idx
-                      parent-path parent-children
-                      down-path
-                      data]
-  (cond
-   ; current node has children? -> first child
-   (not (empty? (:children current))) (conj current-path :children 0)
-   ; not max sibling? -> go to next sibling
-   (and parent-children (< current-child-idx (dec (count parent-children)))) down-path
-   ; else, find next depth wise.
-   :else (or (next-depth-path parent-path @data) current-path)))
-
 (defcomponent component [data owner]
   (init-state [_]
               (let [key-down-chan (listen js/window "keydown")
-                    click-chan (chan)
-                    root-path (om/path data)]
+                    click-chan    (chan)
+                    root-path     (om/path data)]
                 (go (loop []
                       (alt!
+                        ; key down events
+                        ; -------------------------------------------------------------------------------
                         key-down-chan
                         ([e c]

@@ -121,45 +140,43 @@
                                                                                (and (.-metaKey e)  :meta)
                                                                                ]))
                                current-path      (:selected (om/get-state owner))
+                               ; index of current node in parent's children
+                               current-child-idx (last current-path)
                                ; is path root?
-                               is-root           (= [:body 0] current-path)
+                               is-root           (= root-path current-path)
                                ; current node
                                current           (get-in @data current-path)
                                ; parent path
-                               parent-path       (subvec current-path 0 (- (count current-path) 2))
+                               parent-path       (and (not is-root) (subvec current-path 0 (- (count current-path) 2)))
                                ; parent node
-                               parent            (get-in @data parent-path)
+                               parent            (and parent-path (get-in @data parent-path))
                                ; children of parent
-                               parent-children   (get parent :children false)
-                               ; index of current node in parent's children
-                               current-child-idx (last current-path)
+                               parent-children   (and parent (get parent :children false))
                                ;; shared paths
                                ;; ----------------------------------------------------
                                ;; up - lesser sibling in parent
                                ;;    - no change
-                               up-path (cond is-root current-path
-                                             (get parent-children (dec current-child-idx) false)
-                                                (conj parent-path :children (dec current-child-idx))
-                                             :else false)
+                               up-path           (cond is-root false
+                                                       (get parent-children (dec current-child-idx) false)
+                                                       (conj parent-path :children (dec current-child-idx))
+                                                       :else false)
                                ;; down - greater sibling in parent
                                ;;      or no change
-                               down-path (if (get parent-children (inc current-child-idx) false)
-                                             (conj parent-path :children (inc current-child-idx))
-                                             false)
+                               down-path         (if (get parent-children (inc current-child-idx) false)
+                                                     (conj parent-path :children (inc current-child-idx))
+                                                     false)
                                ]

                            (case command
-                             nil (recur)
                              :cursor-up
-                               (om/set-state! owner :selected (if up-path up-path current-path))
+                               (when up-path (om/set-state! owner :selected up-path))
                              :cursor-down
-                               (om/set-state! owner :selected (if down-path down-path current-path))
+                               (when down-path (om/set-state! owner :selected down-path))
                              :cursor-left
                                (om/set-state! owner :selected
                                               (if is-root current-path
                                                   (gen-left-path current-child-idx parent-path
-                                                                 up-path data)
-                                                  ))
+                                                                 up-path data)))

                              :cursor-right
                                (om/set-state! owner :selected
@@ -197,26 +214,60 @@
                                                   ))
                                (om/transact! data
                                              (fn [d]
-                                               (let [new-parent-children (vec (concat (subvec parent-children 0 current-child-idx)
-                                                                                (subvec parent-children (inc current-child-idx))))]
-                                                 (print (pr-str (conj parent-path :children)))
-
+                                               (let [new-parent-children (remove-node-from-parent parent-children current-child-idx)]
                                                  (assoc-in d (conj parent-path :children) new-parent-children)
                                                  ))))

+                             :right-shift-node
+                             (when up-path
+                               (om/transact! data
+                                             (fn [d]
+                                               (let [new-parent-children      (remove-node-from-parent parent-children current-child-idx)
+                                                     destination-path         (conj up-path :children)
+                                                     destination-children     (get-in @data destination-path)
+                                                     new-destination-children (conj destination-children current)]
+                                                 (om/set-state! owner :selected
+                                                                (conj destination-path (dec (count new-destination-children))))
+                                                 (-> d
+                                                     (assoc-in (conj parent-path :children) new-parent-children)
+                                                     (assoc-in destination-path             new-destination-children)
+                                                  )))))
+                             :left-shift-node
+                             (when (and parent-path (not (= parent-path root-node)))
+                               (om/transact! data
+                                             (fn [d]
+                                               (let [new-parent-children  (remove-node-from-parent parent-children current-child-idx)
+                                                     destination-path     (get-indexless parent-path)
+                                                     destination-index    (inc (last parent-path))
+                                                     destination-children (get-in @data destination-path)
+                                                     new-destination-children (vec (concat (subvec destination-children 0 destination-index)
+                                                                                [current]
+                                                                                (subvec destination-children destination-index)))]
+                                                 (om/set-state! owner :selected
+                                                                (conj destination-path destination-index))
+                                                 (-> d
+                                                     (assoc-in destination-path             new-destination-children)
+                                                     (assoc-in (conj parent-path :children) new-parent-children)
+                                                  )))))
+                             (recur)
                              )))
+
+                        ; click events
+                        ; -------------------------------------------------------------------------------
                         click-chan ([e c]
                                     (om/set-state! owner :selected (subvec (:new-path e)
                                                                            (count root-path)))))
                       (recur)))
-                {:selected   [:body 0]
+
+                ; starting state
+                ; -------------------------------------------------------------------------------
+                {:selected   root-node
                  :click-chan click-chan
                  :root-path  root-path}))
   (render-state [_ state]
-                (print (pr-str data))
-                (dom/div {:class "yeah"}
-                         (dom/h2 (pr-str(:selected state)))
-                         (om/build outline-head (:head data))
-                         (dom/ol {:class "root"}
-                                 (om/build-all outline-body (:body data) {:state state})
-                                 ))))
+    (dom/div {:class "yeah"}
+        (dom/h2 (pr-str(:selected state)))
+        (om/build outline-head (:head data))
+        (dom/ol {:class "root"}
+                (om/build-all outline-body (:body data) {:state state})
+                ))))


+"table"

+"table"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -179,7 +179,11 @@
                                        } ;; subcat {
                               } ;; synsem {
                      } ;; end of map
-                    ))])
+                    )
+
+             (unify common
+                    {:synsem {:sem {:pred :be}
+                              :subcat {:2 {:cat :prep}}}}))])

    "be able to" {:english {:imperfect {:1sing "was able to"
                                        :2sing "were able to"
@@ -1028,7 +1032,8 @@
                        :sem {:pred :improve}}}

    "in front of" {:synsem {:cat :prep
-                           :sem {:pred :in-front-of}}}
+                           :sem {:pred :in-front-of
+                                 :obj {:furniture true}}}}

    "increase" {:synsem {:cat :verb
                         :sem {:pred :increase}}}
@@ -1663,6 +1668,10 @@

    "support" {:synsem {:cat :verb
                        :sem {:pred :support}}}
+
+   "table" {:synsem {:agr {:gender :masc}
+                     :cat :noun
+                     :sem {:pred :table}}}

    "take" (let [common {:synsem {:cat :verb}
                         :english {:past "took"
@@ -2191,8 +2200,23 @@
                   (let [obj-sem (atom :top)]
                     {:synsem {:cat :prep
                               :subcat {:1 {:cat :noun
+                                           :case :acc
+                                           :subcat '()
                                            :sem obj-sem}
                                        :2 '()}
-                              :sem {:obj obj-sem}}}))))))
-
-
+                              :sem {:obj obj-sem}}}))
+
+                 (default
+                  (let [location (atom :top)]
+                    {:synsem {:cat :verb
+                              :subcat {:2 {:subcat '()}}}}))
+                 (default
+                  (let [location (atom :top)]
+                    {:synsem {:cat :verb
+                              :sem {:location location}
+                              :subcat {:2 {:cat :prep
+                                           :sem location}}}}))
+
+                 ))))
+
+


Use an arrow in leiningen.help/tasks. Keep it under 80 cols.

--- src/leiningen/help.clj
+++ src/leiningen/help.clj
@@ -2,19 +2,10 @@
   "Display a list of tasks or help for a given task."
   (:use [leiningen.util.ns :only [namespaces-matching]]))

-(defn- ordered-distinct
-  "Just like distinct, but for ordered coll"
-  ([[x & xs]]
-     (ordered-distinct x xs))
-  ([x xs]
-     (if (seq xs)
-       (if (= x (first xs))
-         (recur x (rest xs))
-         (lazy-seq (cons x (ordered-distinct (first xs) (rest xs)))))
-       nil)))
-
-(def tasks (ordered-distinct (sort (filter #(re-find #"^leiningen\.(?!core|util)[^\.]+$" (name %))
-                                           (namespaces-matching "leiningen")))))
+(def tasks (->> (namespaces-matching "leiningen")
+                (filter #(re-find #"^leiningen\.(?!core|util)[^\.]+$" (name %)))
+                (distinct)
+                (sort)))

 (defn get-arglists [task]
   (for [args (:arglists (meta task))]


only ping when I am the user

only ping when I am the user

--- src-cljs/tranjlator/master_view.cljs
+++ src-cljs/tranjlator/master_view.cljs
@@ -110,7 +110,7 @@
                    (= :user-join topic) (om/transact! app :users (fn [col] (conj col (:user-name msg []))))
                    (= :user-part topic) (om/transact! app :users (fn [col] (remove (fn [x] (= x (:user-name msg))) col)))
                    (= (keyword lang) topic) (om/transact! app :translated (fn [col] (conj col msg)))
-                   (= :ping topic) (ping)
+                   (= :ping topic) (when (= (:user-name msg) (:user-name @app)) (ping))
                    (= :error topic) (do (let [name (:user-name @app)]
                                           (put! socket-ctrl "Doh")
                                           (om/update! app :sender-ch (chan))


Work-around to handle old, 12hr truncated ctime dependencies.

This allows voom to build dependencies that have been captured prior
to the 24hr commit time fix in 7c956f2.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -21,7 +21,7 @@
             [org.satta.glob :refer [glob]]
             [robert.hooke :as hooke])
   (:import [clojure.lang #_IPersistentVector Seqable]
-           [java.util Date]
+           [java.util Calendar Date]
            [java.lang.reflect Array]
            [java.io File FileInputStream FileOutputStream OutputStreamWriter
             Closeable]
@@ -78,6 +78,12 @@
              (.setTimeZone (java.util.SimpleTimeZone. 0 "GMT")))
            t))

+(defn parse-formatted-timestamp
+  [^String fmt ^String ts]
+  (.parse (doto (java.text.SimpleDateFormat. fmt java.util.Locale/US)
+             (.setTimeZone (java.util.SimpleTimeZone. 0 "GMT")))
+           ts))
+
 (defn get-voom-version
   [path & {:keys [long-sha? gitdir]}]
   (let [shafmt (if long-sha? "%H" "%h")
@@ -99,10 +105,13 @@
          "-" (formatted-timestamp timestamp-fmt ctime)
          "-g" (re-find #"^.{4,7}" (str sha)))))

+(defn get-project-version
+  [project long-sha?]
+  (-> project :root (get-voom-version :long-sha? long-sha?)))
+
 (defn update-proj-version
-  [project long-sha?]
-  (let [gver (-> project :root (get-voom-version :long-sha? long-sha?))
-        upfn #(format-voom-ver (assoc gver :version %))
+  [project gver]
+  (let [upfn #(format-voom-ver (assoc gver :version %))
         nproj (update-in project [:version] upfn)
         nmeta (update-in (meta project) [:without-profiles :version] upfn)
         nnproj (with-meta nproj nmeta)]
@@ -117,9 +126,10 @@
      foo-1.2.3-20120219_223112-abc123f
      /path/to/foo-1.2.3-20120219_223112-gabc123f19ea8d29b13.jar"
   [ver-str]
-  (let [[_ ctime sha] (re-matches #".*-?([0-9]{8}_?[0-9]{6})-g?([a-f0-9]{4,40})(?:\.jar)?$" ver-str)]
-    (when (and ctime sha)
-      {:ctime (s/replace ctime #"_" "") :sha sha})))
+  (let [[_ ctime-str sha] (re-matches #".*-?([0-9]{8}_?[0-9]{6})-g?([a-f0-9]{4,40})(?:\.jar)?$" ver-str)]
+    (when (and ctime-str sha)
+      (let [ctime (parse-formatted-timestamp timestamp-fmt ctime-str)]
+        {:ctime ctime :sha sha}))))

 (defn dirty-wc?
   [path]
@@ -280,13 +290,14 @@
             sha-candidates)))

 (defn install-versioned-artifact
-  [proot]
+  [version proot]
   (println "Calling recursive build-deps on:" proot)
   (print (:out (sh "lein" "voom" "build-deps" :dir proot)))
   ;; BEWARE: Allowing dirty working copy here is ONLY OK because the
   ;; working copy in question was just checked out and cleaned using
   ;; 'safe-checkout in 'find-matching-projects above:
   (let [install-cmd ["lein" "voom" "wrap" ":insanely-allow-dirty-working-copy"
+                     (str ":expected-version--" version)
                      "install" :dir proot]
         _ (apply println "install-versioned-artifact:" install-cmd)
         rtn (apply sh install-cmd)]
@@ -344,7 +355,7 @@
         (doseq [prj prjs]
           (println "->" (:root prj))))
       (doseq [prj prjs]
-        (install-versioned-artifact (:root prj))))
+        (install-versioned-artifact version (:root prj))))
     (throw (ex-info (str "Not parseable as voom-version: " version) {:artifact art} old-exception))))

 (def null-writer
@@ -773,6 +784,47 @@

 ;; === lein entrypoint ===

+(defn wrap-expected-version-helper [kargset]
+  (->
+   (->>
+    (map name kargset)
+    (filter #(.startsWith ^String % "expected-version--")))
+   first
+   (s/replace-first #"expected-version--" "")
+   (ver-parse)))
+
+(defn- wrap-version-correction-helper
+  "Unfortunately, we need this fix forever...
+  The original voom versions created used a 12hr format, discarding
+  24hr information. Once this was fixed, voom was unable to satisfy
+  old, 12hr truncated dependencies. The this function detects this
+  case and will generate a 12hr truncated version if requested. It
+  still ensures that the sha is identical and will only adjust the
+  time when the old version of voom would have truncated the hours."
+  [expected-version found-version]
+  (if (= found-version expected-version)
+    found-version
+    (do
+      (assert (= (:sha expected-version) (:sha found-version)))
+      (let [^Date found-date (:ctime found-version)
+            ^Calendar found-cal (Calendar/getInstance
+                                 (java.util.SimpleTimeZone. 0 "GMT")
+                                 java.util.Locale/US)
+            _ (.setTime found-cal found-date)
+            adjusted-hours (mod (.get found-cal Calendar/HOUR_OF_DAY) 12)
+            _ (.set found-cal Calendar/HOUR_OF_DAY adjusted-hours)
+            ^Date adjusted-date (.getTime found-cal)]
+        (if (= adjusted-date (:ctime expected-version))
+          (do
+            ;; TODO: Unfortunately, the recursive build-deps calls are
+            ;; eating this warning. Find a way to get message back to user.
+            (binding [*out* *err*]
+              (println (str "Found and fixed 24hr->12hr legacy voom version: "
+                            (pr-str found-version :--> expected-version))))
+            expected-version)
+          (throw (ex-info "Could not resolve expected vs found timestamps."
+                          {:expected-version expected-version :found-version found-version})))))))
+
 (defn wrap
   "Execute any lein task, but using git info as this project's version qualifier.

@@ -788,7 +840,10 @@
   [project & args]
   (let [[kw-like more-args] (split-with #(re-find #"^:" %) args)
         kargset (set (map edn/read-string kw-like))
-        new-project (update-proj-version project (:long-sha kargset))
+        expected-version (wrap-expected-version-helper kargset)
+        found-version (get-project-version project (:long-sha kargset))
+        version (wrap-version-correction-helper expected-version found-version)
+        new-project (update-proj-version project version)
         dirty? (dirty-wc? (:root project))]
     ;; TODO throw exception if upstream doesn't contain this commit :no-upstream
     ;;    :no-upstream - by default voom wants to see the current


Fix on-wall-rotation

Fix on-wall-rotation

--- src/dactyl_keyboard/dactyl-manuform.clj
+++ src/dactyl_keyboard/dactyl-manuform.clj
@@ -439,11 +439,12 @@
 (defn on-wall-place [column depth shape]
   (key-place column 0
     (->> shape
+         (rotate (+ (* β (- centercol column)) (/ π 12)) [0 -1 0])
          (rotate (* α centerrow) [-1 0 0])
-         (rotate (+ (* β (- centercol column)) (/ π 12)) [0 -1 0])
          (translate [0 (/ mount-height 2) -15])
                         ; (Math/sin (/ α 2)))
          )))
+; (def test-shape (on-wall-place 1 20 (translate [2.5 15 5] (cube 5 30 10))))
 (def test-shape (on-wall-place 1 20 (cube 5 30 10)))

 (def teensy-width 20)


Capture update event

Capture update event

--- src/all/cider_ci/server/projects.clj
+++ src/all/cider_ci/server/projects.clj
@@ -52,11 +52,13 @@
 (def projects-chan* (atom nil))

 (defn handle-project-event [event]
-  (logging/info 'handle-project-event event)
-  (case (:operation event)
-    "INSERT" nil ;(init-project (:data_new event))
-    "DELETE" nil ;(de-init-project (:data_old event)
-    ))
+  (catcher/with-logging {}
+    (logging/info 'handle-project-event event)
+    (case (:operation event)
+      "INSERT" nil ;(init-project (:data_new event))
+      "DELETE" nil ;(de-init-project (:data_old event)
+      "UPDATE" nil
+      )))

 ;(async/<!! @projects-chan*)


fixed #311

fixed #311

--- src/cljs/swarmpit/component/page_login.cljs
+++ src/cljs/swarmpit/component/page_login.cljs
@@ -40,7 +40,7 @@
   [local-state]
   (ajax/post
     (routes/path-for-backend :initialize)
-    {:headers nil
+    {:headers {"Authorization" nil}
      :params (select-keys @local-state [:username :password])
      :on-success (fn [_]
                    (login-handler local-state)


Cosmetic change for set-keyspace

Cosmetic change for set-keyspace

--- src/clojure/clojurewerkz/cassaforte/cql.clj
+++ src/clojure/clojurewerkz/cassaforte/cql.clj
@@ -159,4 +159,4 @@

 (defn set-keyspace!
   [keyspace]
-  (execute "USE \"?\" " [keyspace]))+  (execute "USE \"?\"" [keyspace]))


Add some real OSC bindings for aim group cues.

This is starting to make clear how OSC could be useful, and after this
show I should move the supporting functions into their own namespace and
review and document them.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -140,6 +140,117 @@
   main lighting rig as set up in the current venue."
   (tf/inches 62.5))

+(def stage-wall
+  "The location of the wall behind the rig on the show Z axis."
+  (tf/inches -20))
+
+(def house-rear-wall
+  "The location of the wall behind the audience onthe show Z axis."
+  (tf/inches 300))
+
+(def left-wall
+  "The location of the house left wall on the show X axis."
+  (tf/inches -88))
+
+(def right-wall
+  "The location of the house right wall on the show X axis."
+  (tf/inches 88))
+
+(def ceiling
+  "The location of the ceiling on the show Y axis."
+  (tf/inches 120))
+
+(defonce ^{:doc "Allow us to send messages to an OSC interface like TouchOSC."}
+  osc-client
+  (atom nil))
+
+;; TODO: This kind of binding and tracking should be moved into an osc support namespace.
+(defonce ^{:doc "Keep track of any OSC cue bindings we have set up,
+  so we can clear them out before re-creating the show."}
+  osc-cue-bindings
+  (atom #{}))
+
+(defn add-osc-cue-binding
+  "Set up a binding so the state of a cue gets communicated via OSC,
+  and record that we did that so it can be cleaned up later. Then set
+  up so that incoming OSC messages can start and end that cue."
+  [x y path]
+  (let [binding (fn [state _ _]
+                  (case state
+                    :started (osc/osc-send @osc-client path 1)
+                    :ended (osc/osc-send @osc-client path 0)
+                    nil))]
+    (swap! osc-cue-bindings conj [x y binding path])
+    (ct/add-cue-fn! (:cue-grid *show*) x y binding))
+
+  (osc/osc-handle @core/osc-server path
+                  (fn [msg]
+                    (let [[cue active] (show/find-cue-grid-active-effect *show* x y)]
+                      (when cue
+                        (if (pos? (first (:args msg)))
+                          (if (and active (not (:held cue)))
+                            (show/end-effect! (:key cue))
+                            (show/add-effect-from-cue-grid! x y))
+                          (when (and active (:held cue))
+                            (show/end-effect! (:key cue)))))))))
+
+(defn- clear-osc-cue-bindings
+  "Clear out any OSC cue bindings which have been established."
+  []
+  (doseq [[x y f path] @osc-cue-bindings]
+    (ct/clear-cue-fn! x y f)
+    (osc/osc-handle @core/osc-server path
+                    (fn [msg] :done)))
+  (reset! osc-cue-bindings #{}))
+
+(defonce ^{:doc "Keep track of any OSC var bindings we have set up,
+  so we can clear them out before re-creating the show."}
+  osc-var-bindings
+  (atom #{}))
+
+(defn add-osc-var-binding
+  "Arrange to send an OSC message whenever the value of a show
+  variable changes, and record that we did that so it can be cleaned
+  up later. The set up so incoming OSC messages update the value of that variable.
+
+  If you need to do anything more complicated than send a message with
+  the raw value of the variable, or update the variable with the raw
+  first value from the incoming OSC message, you can pass your own
+  functions with the optional keyword arguments `:send-fn` and
+  `:receive-fn`. `:send-fn` will be called with the keyword
+  identifying the variable that has changed, and its new value.
+  `:receive-fn` will be called with the incoming OSC message.
+
+  If you want this binding to not affect reception of messages on the
+  OSC path (for example because you have another variable binding set
+  up which processes these messages, since they contain values for
+  multiple show variables), then pass `:none` as the value for
+  `:receive-fn`."
+  [var-key path & {:keys [send-fn receive-fn]}]
+  (let [have-receiver (not= receive-fn :none)
+        binding (or send-fn
+                    (fn [_ v]
+                      (osc/osc-send @osc-client path v)))]
+    (swap! osc-var-bindings conj [var-key binding path have-receiver])
+    (show/add-variable-set-fn! var-key binding)
+
+    (when have-receiver
+      (osc/osc-handle @core/osc-server path
+                      (or receive-fn
+                          (fn [msg]
+                            (show/set-variable! var-key (first (:args msg)))))))))
+
+(defn- clear-osc-var-bindings
+  "Clear out any OSC var bindings which have been established."
+  []
+  (doseq [[k f path have-receiver] @osc-var-bindings]
+    (show/clear-variable-set-fn! k f)
+    (when have-receiver (osc/osc-handle @core/osc-server path
+                                        (fn [msg] :done))))
+  (reset! osc-var-bindings #{}))
+
+(declare make-cues)
+
 (defn use-sample-show
   "Set up a sample show for experimenting with Afterglow. By default
   it will create the show to use universe 1, but if you want to use a
@@ -171,7 +282,19 @@
   #_(show/patch-fixture! :puck-1 (blizzard/puck-fab5) universe 97 :x (tf/inches -76) :y (tf/inches 8) :z (tf/inches 52))
   #_(show/patch-fixture! :puck-2 (blizzard/puck-fab5) universe 113 :x (tf/inches -76) :y (tf/inches 8) :z (tf/inches 40))

+  ;; Turn on the OSC server, and clear any variable bindings that might have been around from previous runs.
+  (when (nil? @core/osc-server)
+    (core/start-osc-server 16010))
+  (clear-osc-var-bindings)
+
+  ;; Enable cues whose purpose is to set show variable values while they run.
   (reset! var-binder (var-fx/create-for-show *show*))
+
+  ;; Create a bunch of example cues
+  (make-cues)
+
+  ;; Return the symbol through which the show can be accessed, rather than the value itself,
+  ;; which is huge and causes issues for some REPL environments.
   '*show*)

 (defn global-color-effect
@@ -285,6 +408,7 @@
   grids, and the like."
   []
   (when (nil? @core/osc-server) (core/start-osc-server 16010))
+
   (let [left (tf/inches -88)
         right (tf/inches 86)
         width (- right left)
@@ -328,6 +452,8 @@
 (defn osc-shutdown
   "Shut down osc server and clean up."
   []
+  (clear-osc-var-bindings)
+  (clear-osc-cue-bindings)
   (core/stop-osc-server))

 (defn make-color-cue
@@ -741,10 +867,7 @@
                      (cues/function-cue :strobe-all :strobe (show/all-fixtures) :effect-name "Raw Strobe"))

-    ;; Dimmer cues to turn on and set brightness of groups of lights
-    (make-dimmer-cue nil (+ x-base 0) (+ y-base 2) :yellow)
-    (doall (map-indexed (fn [i group] (make-dimmer-cue group (+ x-base (inc i)) (+ y-base 2) :yellow)) light-groups))
-
+    ;; The fun sparkle cue, and a binding so TouchOSC can control it and show its state
     (show/set-cue! (+ x-base 7) (+ y-base 2)
                    (cues/cue :sparkle (fn [var-map]
                                         (cues/apply-merging-var-map var-map fun/sparkle (show/all-fixtures)))
@@ -752,6 +875,11 @@
                              :priority 100
                              :variables [{:key "chance" :min 0.0 :max 0.4 :start 0.05 :velocity true}
                                          {:key "fade-time" :name "Fade" :min 1 :max 2000 :start 50 :type :integer}]))
+    (add-osc-cue-binding (+ x-base 7) (+ y-base 2) "/1/sparkle")
+
+    ;; Dimmer cues to turn on and set brightness of groups of lights
+    (make-dimmer-cue nil (+ x-base 0) (+ y-base 2) :yellow)
+    (doall (map-indexed (fn [i group] (make-dimmer-cue group (+ x-base (inc i)) (+ y-base 2) :yellow)) light-groups))

     ;; Dimmer oscillator cues: Sawtooth
     (make-sawtooth-dimmer-cue nil (+ x-base 0) (+ y-base 3) :yellow)
@@ -1329,7 +1457,9 @@
   (let [x-base (* page-x 8)
         y-base (* page-y 8)
         fixtures [:torrent-1 :torrent-2 :blade-1 :blade-2 :blade-3 :blade-4 :blade-5]
-        transform (Transform3D.)]
+        transform (Transform3D.)
+        width (- right-wall left-wall)
+        depth (- house-rear-wall stage-wall)]

     ;; Set up default shared aiming coordinates
     (show/set-variable! :aim-group-a-x 0.0)
@@ -1339,6 +1469,53 @@
     (show/set-variable! :aim-group-b-y 0.0)
     (show/set-variable! :aim-group-b-z 2.0)

+    ;; Set up OSC bindings so Touch OSC can control these cues in a powerful way with XY pads.
+    (add-osc-var-binding :aim-group-a-x "/1/aim-a"
+                         :send-fn (fn [_ v]
+                                    (osc/osc-send @osc-client "/1/aim-a"
+                                                  (/ (- v left-wall) width)
+                                                  (/ (- (show/get-variable :aim-group-a-z) stage-wall) depth)))
+                         :receive-fn (fn [msg]
+                                       (show/set-variable! :aim-group-a-x
+                                                           (+ left-wall (* width (first (:args msg)))))
+                                       (show/set-variable! :aim-group-a-z
+                                                           (+ stage-wall (* depth (second (:args msg)))))))
+    (add-osc-var-binding :aim-group-a-z "/1/aim-a"
+                         :send-fn (fn [_ v]
+                                    (osc/osc-send @osc-client "/1/aim-a"
+                                                  (/ (- (show/get-variable :aim-group-a-x) left-wall) width)
+                                                  (/ (- v stage-wall) depth)))
+                         :receive-fn :none)
+
+    (add-osc-var-binding :aim-group-a-y "/1/aim-a-y"
+                         :send-fn (fn [_ v]
+                                    (osc/osc-send @osc-client "/1/aim-a-y" (/ v ceiling)))
+                         :receive-fn (fn [msg]
+                                       (show/set-variable! :aim-group-a-y (* ceiling (first (:args msg))))))
+
+    (add-osc-var-binding :aim-group-b-x "/1/aim-b"
+                         :send-fn (fn [_ v]
+                                    (osc/osc-send @osc-client "/1/aim-b"
+                                                  (/ (- v left-wall) width)
+                                                  (/ (- (show/get-variable :aim-group-b-z) stage-wall) depth)))
+                         :receive-fn (fn [msg]
+                                       (show/set-variable! :aim-group-b-x
+                                                           (+ left-wall (* width (first (:args msg)))))
+                                       (show/set-variable! :aim-group-b-z
+                                                           (+ stage-wall (* depth (second (:args msg)))))))
+    (add-osc-var-binding :aim-group-b-z "/1/aim-b"
+                         :send-fn (fn [_ v]
+                                    (osc/osc-send @osc-client "/1/aim-b"
+                                                  (/ (- (show/get-variable :aim-group-b-x) left-wall) width)
+                                                  (/ (- v stage-wall) depth)))
+                         :receive-fn :none)
+
+    (add-osc-var-binding :aim-group-b-y "/1/aim-b-y"
+                         :send-fn (fn [_ v]
+                                    (osc/osc-send @osc-client "/1/aim-b-y" (/ v ceiling)))
+                         :receive-fn (fn [msg]
+                                       (show/set-variable! :aim-group-b-y (* ceiling (first (:args msg))))))
+
     ;; Set up default transformation of a reflection over the Y axis
     (.setScale transform (Vector3d. -1.0 1.0 1.0))
     (show/set-variable! :aim-group-a-transform transform)
@@ -1350,14 +1527,22 @@
         (let [fixture (first fixtures)]
           ;; Disconnected individual aim cues
           (show/set-cue! (+ x-base index) y-base (build-aim-cue fixture nil false :white))
+
           ;; Group A untransformed aim cues
-          (show/set-cue! (+ x-base index) (inc y-base) (build-aim-cue fixture "a" false :blue))
+          (show/set-cue! (+ x-base index) (inc y-base) (build-aim-cue fixture "a" false :red))
+          (add-osc-cue-binding (+ x-base index) (inc y-base) (str "/1/aim-" (name fixture) "-a"))
+
           ;; Group A transformed aim cues
-          (show/set-cue! (+ x-base index) (+ y-base 2) (build-aim-cue fixture "a" true :cyan))
+          (show/set-cue! (+ x-base index) (+ y-base 2) (build-aim-cue fixture "a" true :orange))
+          (add-osc-cue-binding (+ x-base index) (+ y-base 2) (str "/1/flip-" (name fixture) "-a"))
+
           ;; Group B untransformed aim cues
-          (show/set-cue! (+ x-base index) (+ y-base 3) (build-aim-cue fixture "b" false :red))
+          (show/set-cue! (+ x-base index) (+ y-base 3) (build-aim-cue fixture "b" false :blue))
+          (add-osc-cue-binding (+ x-base index) (+ y-base 3) (str "/1/aim-" (name fixture) "-b"))
+
           ;; Group B transformed aim cues
-          (show/set-cue! (+ x-base index) (+ y-base 4) (build-aim-cue fixture "b" true :orange)))
+          (show/set-cue! (+ x-base index) (+ y-base 4) (build-aim-cue fixture "b" true :cyan))
+          (add-osc-cue-binding (+ x-base index) (+ y-base 4) (str "/1/flip-" (name fixture) "-b")))
         (recur (rest fixtures) (inc index))))

     ;; Transformation modifiers for group A
@@ -1367,14 +1552,16 @@
                                (let [transform (Transform3D.)]
                                  (.setScale transform (Vector3d. 1.0 -1.0 1.0))
                                  (var-fx/variable-effect @var-binder :aim-group-a-transform transform)))
-                             :color :cyan :short-name "Group B flip Y"))
+                             :color :cyan :short-name "Group A flip Y"))
+    (add-osc-cue-binding (+ x-base 7) (inc y-base) "/1/flip-a-y")
     (show/set-cue! (+ x-base 7) (+ y-base 2)
                    (cues/cue :aim-group-a-transform
                              (fn [_]
                                (let [transform (Transform3D.)]
                                  (.setScale transform (Vector3d. -1.0 -1.0 1.0))
                                  (var-fx/variable-effect @var-binder :aim-group-a-transform transform)))
-                             :color :cyan :short-name "Group B flip XY"))
+                             :color :cyan :short-name "Group A flip XY"))
+    (add-osc-cue-binding (+ x-base 7) (+ y-base 2) "/1/flip-a-xy")

     ;; Transformation modifiers for group B
     (show/set-cue! (+ x-base 7) (+ y-base 3)
@@ -1384,13 +1571,15 @@
                                  (.setScale transform (Vector3d. 1.0 -1.0 1.0))
                                  (var-fx/variable-effect @var-binder :aim-group-b-transform transform)))
                              :color :orange :short-name "Group B flip Y"))
+    (add-osc-cue-binding (+ x-base 7) (+ y-base 3) "/1/flip-b-y")
     (show/set-cue! (+ x-base 7) (+ y-base 4)
                    (cues/cue :aim-group-b-transform
                              (fn [_]
                                (let [transform (Transform3D.)]
                                  (.setScale transform (Vector3d. -1.0 -1.0 1.0))
                                  (var-fx/variable-effect @var-binder :aim-group-b-transform transform)))
-                             :color :orange :short-name "Group B flip XY"))))
+                             :color :orange :short-name "Group B flip XY"))
+    (add-osc-cue-binding (+ x-base 7) (+ y-base 4) "/1/flip-b-xy")))

 (defn- direction-cue-var-key
   "Determine the cue variable key value to use for a variable being
@@ -1547,6 +1736,14 @@
 (defn make-cues
   "Create a bunch of example cues for experimentation."
   []
+  ;; Create an OSC client that so cues can send their state to TouchOSC.
+  (when (nil? @osc-client)
+    (reset! osc-client (osc/osc-client "172.30.246.46" 9000)))
+
+  ;; Clean up any OSC cue bindings which previously existed.
+  (clear-osc-cue-bindings)
+
+  ;; Fill in some cue pages
   (make-main-color-dimmer-cues 0 0)  ; Creates a sigle 8x8 page at the origin
   (make-torrent-cues 0 2)  ; Creates 2 8x8 pages: two pages up from the origin, and the next page to the right
   (make-ambient-cues 1 0)  ; Creates a single 8x8 page to the right of the origin


It fucking works!

It fucking works!

--- src/main/clojure/stl_collector/core.clj
+++ src/main/clojure/stl_collector/core.clj
@@ -2,3 +2,12 @@
   (:require [stl-collector.reader :as r]
             [stl-collector.writer :as w]
             [stl-collector.transforms :as t]))
+
+
+(defn combine-files [output & filenames]
+  (let [stls (map r/read-stl filenames)
+        faces (map t/facify stls)
+        distributed-faces (t/distribute-x faces 10)
+        recombined-faces (t/combine distributed-faces)
+        normalized-faces (t/normalize recombined-faces)]
+    (w/write-stl normalized-faces output)))


replacing other things with hotter seq functions

--- src/mediakeys/core.clj
+++ src/mediakeys/core.clj
@@ -29,11 +29,9 @@
 (defn sub-to-keypresses []
     (let [changes (from-seq dose-keys)
           presses (keypress-events! changes)]
-        (.subscribe presses
-            (rx/action [x]
-                (println x)))))
+        (sub presses println)))

-(def keypresses (-> incoming-json  keypress-events! (.map (rx/fn* name))))
+(def keypresses (-> incoming-json  keypress-events! (map name)))

 (defn -main []
   (doto (WebServers/createWebServer 8080)
@@ -41,15 +39,14 @@
           (proxy [WebSocketHandler] []
             (onOpen [c]
                 (println "yo opened")
-                (.subscribe keypresses
-                    (rx/action [action]
+                (sub keypresses
+                    (fn [action]
                         (.send c action))))
             (onClose [c] (println "closed" c))
             (onMessage [c j]
                 (.onNext @incoming-sub j))))
     (.add (StaticFileHandler. "."))
     (.start))
-  (.subscribe keypresses
-      (rx/action* println))
+  (sub keypresses println)
   (println @incoming-sub)
   (.onNext @incoming-sub "{}"))


modify the `send-message` function to optionally accept a `:details` kwarg which specifies the smtp details to use when sending the email.  if not supplied we fall back on our normal smtp details from the application settings.

--- src/metabase/email.clj
+++ src/metabase/email.clj
@@ -1,12 +1,14 @@
 (ns metabase.email
   (:require [clojure.tools.logging :as log]
             [postal.core :as postal]
+            [postal.support :refer [make-props]]
             [metabase.models.setting :refer [defsetting]]
-            [metabase.util :as u]))
+            [metabase.util :as u])
+  (:import [javax.mail Session]))

 ;; ## CONFIG

-(defsetting email-from-address "Email address you want to use as the sender of Metabase system notifications." "notifications@metabase.com")
+(defsetting email-from-address "Email address you want to use as the sender of Metabase." "notifications@metabase.com")
 (defsetting email-smtp-host "The address of the SMTP server that handles your emails.")
 (defsetting email-smtp-username "SMTP username.")
 (defsetting email-smtp-password "SMTP password.")
@@ -20,6 +22,24 @@
    Provided so you can swap this out with an \"inbox\" for test purposes."
   postal/send-message)

+(def ^:private smtp-details
+  "Get our application SMTP connection details from settings"
+  (delay
+    {:host     (email-smtp-host)
+     :user     (email-smtp-username)
+     :pass     (email-smtp-password)
+     :port     (email-smtp-port)
+     :security (email-smtp-security)
+     :from     (email-from-address)}))
+
+(defn- humanize-error-messages
+  ""
+  [response]
+  ;; bad host = "Unknown SMTP host: foobar"
+  ;; host seems valid, but host/port failed connection = "Could not connect to SMTP host: localhost, port: 123"
+  ;; mandrill saying "Invalid Addresses" when wrong credentials provided
+  )
+
 (defn send-message
   "Send an email to one or more RECIPIENTS.
    RECIPIENTS is a sequence of email addresses; MESSAGE-TYPE must be either `:text` or `:html`.
@@ -31,34 +51,51 @@
       :message      \"How are you today?\")

    Upon success, this returns the MESSAGE that was just sent."
-  [& {:keys [subject recipients message-type message]}]
+  [& {:keys [details subject recipients message-type message]
+      :or   {details @smtp-details}}]
   {:pre [(string? subject)
          (sequential? recipients)
          (every? u/is-email? recipients)
          (contains? #{:text :html} message-type)
-         (string? message)]}
+         (string? message)
+         (map? details)]}
   (try
     ;; Check to make sure all valid settings are set!
-    (when-not (email-smtp-host)
+    (when-not (:host details)
       (throw (Exception. "SMTP host is not set.")))
     ;; Now send the email
-    (let [{error :error error-message :message} (*send-email-fn* (-> {:host (email-smtp-host)
-                                                                      :user (email-smtp-username)
-                                                                      :pass (email-smtp-password)
-                                                                      :port (Integer/parseInt (email-smtp-port))}
-                                                                     (merge (case (keyword (email-smtp-security))
-                                                                              :tls {:tls true}
-                                                                              :ssl {:ssl true}
-                                                                              {})))
-                                                                 {:from    (email-from-address)
-                                                                  :to      recipients
-                                                                  :subject subject
-                                                                  :body    (case message-type
-                                                                             :text message
-                                                                             :html [{:type    "text/html; charset=utf-8"
-                                                                                :content message}])})]
-      (when-not (= error :SUCCESS)
-        (throw (Exception. (format "Emails failed to send: error: %s; message: %s" error error-message))))
-      message)
+    (let [{:keys [from port security]} details]
+      (*send-email-fn* (-> (assoc details :port (Integer/parseInt port))
+                           (merge (case (keyword security)
+                                    :tls {:tls true}
+                                    :ssl {:ssl true}
+                                    {})))
+                       {:from    from
+                        :to      recipients
+                        :subject subject
+                        :body    (case message-type
+                                   :text message
+                                   :html [{:type    "text/html; charset=utf-8"
+                                           :content message}])}))
     (catch Throwable e
-      (log/warn "Failed to send email: " (.getMessage e)))))
+      (log/warn "Failed to send email: " (.getMessage e))
+      {:error   :ERROR
+       :message (.getMessage e)})))
+
+(defn test-connection
+  ""
+  [{:keys [host port user pass sender ssl] :as details}]
+  {:pre [(string? host)
+         (integer? port)]}
+  (try
+    (let [proto   (if ssl "smtps" "smtp")
+          session (doto (Session/getInstance (make-props sender (assoc details :proto proto)))
+                    (.setDebug false))]
+      (with-open [transport (.getTransport session proto)]
+        (.connect transport host port user pass)))
+    {:error   :SUCCESS
+     :message nil}
+    (catch Exception e
+      (println "err" (.getMessage e))
+      {:error   :ERROR
+       :message (.getMessage e)})))


Add var confirmation in doc impl

Add var confirmation in doc impl

--- ClojureScript/replete/src/replete/core.cljs
+++ ClojureScript/replete/src/replete/core.cljs
@@ -99,7 +99,7 @@
                       (repl/print-doc (repl-special-doc (second form)))
                       (repl/print-doc
                         (let [sym (second form)
-                              var (ana/resolve-var env sym)]
+                              var (ana/resolve-var env sym (ana/confirm-var-exists-throw))]
                           (update (:meta var)
                             :doc (if (user-interface-idiom-ipad?)
                                    identity


Use the node specified in `create-session`.

--- src/shale/sessions.clj
+++ src/shale/sessions.clj
@@ -342,8 +342,15 @@
     (throw
       (ex-info "All nodes are over capacity!"
                {:user-visible true :status 503})))
-  (let [merged-reqs
-        (merge {:node (select-keys (nodes/get-node {}) [:url :id])
+  (let [node-req (if (contains? node :url)
+                   (assoc-in-fn
+                     node
+                     [:url]
+                     (comp str host-resolved-url))
+                   (or node {}))
+        node (nodes/get-node node-req)
+        merged-reqs
+        (merge {:node (select-keys node [:url :id])
                 :tags tags}
                (select-keys requirements
                             [:browser-name


fixes for error banner view

fixes for error banner view

--- src/braid/ui/views/error_banner.cljs
+++ src/braid/ui/views/error_banner.cljs
@@ -6,9 +6,11 @@
   (let [errors (subscribe [:errors])]
     (fn []
       [:div.error-banners
-       (for [[err-key err] @errors]
-         [:div.error-banner
-          err
-          [:span.close
-           {:on-click (fn [_] (store/clear-error! err-key))}
-           "×"]])])))
+       (doall
+         (for [[err-key err] @errors]
+           ^{:key err-key}
+           [:div.error-banner
+            err
+            [:span.close
+             {:on-click (fn [_] (store/clear-error! err-key))}
+             "×"]]))])))


Remove reflection warning.

Remove reflection warning.

--- test/fleetdb/embedded_test.clj
+++ test/fleetdb/embedded_test.clj
@@ -92,6 +92,6 @@
   (with-dba [dba-0 (embedded/init-persistent log-path)]
     (dotimes [i 3]
       (embedded/query dba-0 ["insert" "elems" {"id" (+ 3 i)}])))
-  (.setLength (RandomAccessFile. (File. log-path) "rw") 70)
+  (.setLength (RandomAccessFile. (File. #^String log-path) "rw") 70)
   (with-dba [dba-1 (embedded/load-persistent log-path)]
     (assert= 2 (embedded/query dba-1 ["count" "elems"]))))


add clear-storage! in case you hose whatever is saved

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

--- src/aurora/editor/ui2.cljs
+++ src/aurora/editor/ui2.cljs
@@ -450,6 +450,9 @@
       (reset! aurora-state (thaw stored))
       (reset! aurora-state (thaw default-state)))))

+(defn clear-storage! []
+  (aset js/localStorage "aurora-state" nil))
+
 (add-watch aurora-state :storage (fn [_ _ _ cur]
                                    (store! cur)))


simple rest routing

simple rest routing

--- rest-demo/src/rest_demo/handler.clj
+++ rest-demo/src/rest_demo/handler.clj
@@ -3,9 +3,19 @@
             [compojure.route :as route]
             [ring.middleware.defaults :refer [wrap-defaults site-defaults]]))

+(defn handle-http []
+  (context "/:id" [id]
+           (defroutes api-routes
+             (GET "/" [] (str "get called: " id "\n"))
+             (POST "/" {form-params :form-params} (str "post called: " id "\n" form-params " \n"))
+             (PUT "/" req (str "put called with params: " req))
+             (DELETE "/" [] (str "delete called: " id "\n")))))
+
 (defroutes app-routes
-  (GET "/" [] "Hello World")
-  (route/not-found "Not Found"))
+  (handle-http)
+  (route/not-found (str "This is the default page - try"
+                        "this")))

 (def app
-  (wrap-defaults app-routes site-defaults))
+  (wrap-defaults app-routes
+                 (assoc-in site-defaults [:security :anti-forgery] false)))


Remove extraneous console log.

Remove extraneous console log.

--- src/dummy_om_app/app/components/navbar.cljs
+++ src/dummy_om_app/app/components/navbar.cljs
@@ -13,7 +13,6 @@

 (defcomponent navbar-link
   (render
-   (println opts)
    (let [{:keys [link-text current-view]} opts
          app-url                          (link-text->app-url link-text)
          class-name                       (if (= app-url current-view)


extract the repeated logic into macro: with-cluster

--- src/clj/backtype/storm/testing4j.clj
+++ src/clj/backtype/storm/testing4j.clj
@@ -34,8 +34,7 @@
              ^:static [advanceClusterTime [backtype.storm.testing.Cluster Integer Integer] void]
              ^:static [advanceClusterTime [backtype.storm.testing.Cluster Integer] void]
              ^:static [eq [java.util.Collection java.util.Collection] boolean]
-             ^:static [eq [java.util.Map java.util.Map] boolean]])
-  )
+             ^:static [eq [java.util.Map java.util.Map] boolean]]))

 (defn -completeTopology
   ([^Cluster cluster ^StormTopology topology ^CompleteTopologyParam completeTopologyParam]
@@ -55,42 +54,31 @@
   (with-simulated-time
     (.run code)))

+(defmacro with-cluster [cluster-type mkClusterParam code]
+  `(let [supervisors# (or (.getSupervisors ~mkClusterParam) 2)
+         ports-per-supervisor# (or (.getPortsPerSupervisor ~mkClusterParam) 3)
+         daemon-conf# (or (.getDaemonConf ~mkClusterParam) {})]
+     (~cluster-type [cluster# :supervisors supervisors#
+                     :ports-per-supervisor ports-per-supervisor#
+                     :daemon-conf daemon-conf#]
+                    (let [cluster# (Cluster. cluster#)]
+                      (.run ~code cluster#)))))
+
 (defn -withLocalCluster
   ([^MkClusterParam mkClusterParam ^TestJob code]
-     (let [supervisors (or (.getSupervisors mkClusterParam) 2)
-           ports-per-supervisor (or (.getPortsPerSupervisor mkClusterParam) 3)
-           daemon-conf (or (.getDaemonConf mkClusterParam) {})]
-       (with-local-cluster [cluster :supervisors supervisors
-                            :ports-per-supervisor ports-per-supervisor
-                            :daemon-conf daemon-conf]
-         (let [cluster (Cluster. cluster)]
-           (.run code cluster)))))
+     (with-cluster with-local-cluster mkClusterParam code))
   ([^TestJob code]
      (-withLocalCluster (MkClusterParam.) code)))

 (defn -withSimulatedTimeLocalCluster
   ([^MkClusterParam mkClusterParam ^TestJob code]
-     (let [supervisors (or (.getSupervisors mkClusterParam) 2)
-           ports-per-supervisor (or (.getPortsPerSupervisor mkClusterParam) 3)
-           daemon-conf (or (.getDaemonConf mkClusterParam) {})]
-       (with-simulated-time-local-cluster [cluster :supervisors supervisors
-                                           :ports-per-supervisor ports-per-supervisor
-                                           :daemon-conf daemon-conf]
-         (let [cluster (Cluster. cluster)]
-           (.run code cluster)))))
+     (with-cluster with-simulated-time-local-cluster mkClusterParam code))
   ([^TestJob code]
      (-withSimulatedTimeLocalCluster (MkClusterParam.) code)))

 (defn -withTrackedCluster
   ([^MkClusterParam mkClusterParam ^TestJob code]
-     (let [supervisors (or (.getSupervisors mkClusterParam) 2)
-           ports-per-supervisor (or (.getPortsPerSupervisor mkClusterParam) 3)
-           daemon-conf (or (.getDaemonConf mkClusterParam) {})]
-       (with-tracked-cluster [cluster :supervisors supervisors
-                              :ports-per-supervisor ports-per-supervisor
-                              :daemon-conf daemon-conf]
-         (let [cluster (Cluster. cluster)]
-           (.run code cluster)))))
+     (with-cluster with-tracked-cluster mkClusterParam code))
   ([^TestJob code]
      (-withTrackedCluster (MkClusterParam.) code)))

@@ -113,8 +101,6 @@

 (defn -submitLocalTopology [^Object nimbus ^String topologyName ^Config config ^StormTopology topology]
   (submit-local-topology nimbus topologyName config topology))
-
-

 (defn -mkTrackedTopology [^Cluster trackedCluster ^StormTopology topology]
   (-> (mk-tracked-topology trackedCluster topology)


Added usage to mk-date-header

Added usage to mk-date-header

--- src/clj/forma/postprocess/output.clj
+++ src/clj/forma/postprocess/output.clj
@@ -59,6 +59,8 @@
   (reduce str (split date-str #"-")))

 (defn mk-date-header
+  "(mk-date-header \"16\" \"p\" (s/timeseries-value 827 (range 141)))
+  => (\"p20051219\" \"p20060101\" \"p20060117\" ... \"p20120117\")"
   [tres prefix ts]
   (map (comp (partial str prefix)
              date-no-sep


CMR-7446: Bumped rhino version (#1281)

CMR-7446: Bumped rhino version (#1281)

--- search-app/project.clj
+++ search-app/project.clj
@@ -11,7 +11,8 @@
                org.clojure/tools.reader
                org.eclipse.emf/org.eclipse.emf.common
                org.eclipse.emf/org.eclipse.emf.ecore
-               ring/ring-codec]
+               ring/ring-codec
+               org.mozilla/rhino]
   :dependencies [[cheshire "5.8.1"]
                  [clj-time "0.15.1"]
                  [com.fasterxml.jackson.core/jackson-annotations "2.12.0"]
@@ -42,6 +43,7 @@
                  [org.geotools/gt-shapefile "23-RC"]
                  [org.geotools/gt-geojsondatastore "23-RC"]
                  [org.geotools.xsd/gt-xsd-kml "23-RC"]
+                 [org.mozilla/rhino "1.7.12"]
                  [ring/ring-codec "1.1.3"]
                  [ring/ring-core "1.9.2"]
                  [ring/ring-json "0.5.1"]


Re-ordered deps alphabetically.

Re-ordered deps alphabetically.

This makes it much easier to find deps.

--- search-app/project.clj
+++ search-app/project.clj
@@ -5,22 +5,22 @@
 (defproject nasa-cmr/cmr-search-app "0.1.0-SNAPSHOT"
   :description "Provides a public search API for concepts in the CMR."
   :url "https://github.com/nasa/Common-Metadata-Repository/tree/master/search-app"
-  :dependencies [[org.clojure/clojure "1.8.0"]
+  :dependencies [[com.github.fge/json-schema-validator "2.2.6"]
+                 [nasa-cmr/cmr-collection-renderer-lib "0.1.0-SNAPSHOT"]
+                 [nasa-cmr/cmr-common-app-lib "0.1.0-SNAPSHOT"]
+                 [nasa-cmr/cmr-common-lib "0.1.1-SNAPSHOT"]
+                 [nasa-cmr/cmr-elastic-utils-lib "0.1.0-SNAPSHOT"]
                  [nasa-cmr/cmr-metadata-db-app "0.1.0-SNAPSHOT"]
+                 [nasa-cmr/cmr-orbits-lib "0.1.0-SNAPSHOT"]
+                 [nasa-cmr/cmr-spatial-lib "0.1.0-SNAPSHOT"]
                  [nasa-cmr/cmr-umm-lib "0.1.0-SNAPSHOT"]
                  [nasa-cmr/cmr-umm-spec-lib "0.1.0-SNAPSHOT"]
-                 [nasa-cmr/cmr-spatial-lib "0.1.0-SNAPSHOT"]
-                 [nasa-cmr/cmr-common-app-lib "0.1.0-SNAPSHOT"]
-                 [nasa-cmr/cmr-common-lib "0.1.1-SNAPSHOT"]
-                 [nasa-cmr/cmr-collection-renderer-lib "0.1.0-SNAPSHOT"]
-                 [nasa-cmr/cmr-orbits-lib "0.1.0-SNAPSHOT"]
+                 [net.sf.saxon/Saxon-HE "9.7.0-7"]
+                 [org.clojure/clojure "1.8.0"]
+                 [org.clojure/data.csv "0.1.3"]
+                 [org.clojure/tools.nrepl "0.2.12"]
                  [ring/ring-core "1.5.0"]
                  [ring/ring-json "0.4.0"]
-                 [nasa-cmr/cmr-elastic-utils-lib "0.1.0-SNAPSHOT"]
-                 [org.clojure/data.csv "0.1.3"]
-                 [org.clojure/tools.nrepl "0.2.12"]
-                 [net.sf.saxon/Saxon-HE "9.7.0-7"]
-                 [com.github.fge/json-schema-validator "2.2.6"]
                  [selmer "1.10.7"]

                  ;; Temporary inclusion of libraries needed for swagger UI until the dev portal is


delete 'some?', change 'zip-contains-dir?'. make storm-core/src/clj/backtype/storm/util.clj compatible with clojure 1.6. in fact zip-contains-dir? use some? will include empty zip file.

--- storm-core/src/clj/backtype/storm/util.clj
+++ storm-core/src/clj/backtype/storm/util.clj
@@ -566,10 +566,6 @@
   (while (not (apredicate))
     (Time/sleep 100)))

-(defn some?
-  [pred aseq]
-  ((complement nil?) (some pred aseq)))
-
 (defn time-delta
   [time-secs]
   (- (current-time-secs) time-secs))
@@ -803,7 +799,7 @@
 (defn zip-contains-dir?
   [zipfile target]
   (let [entries (->> zipfile (ZipFile.) .entries enumeration-seq (map (memfn getName)))]
-    (some? #(.startsWith % (str target "/")) entries)))
+    (some #(.startsWith % (str target "/")) entries)))

 (defn url-encode
   [s]


Fix #34 & add more watcher debugs

Fix #34 & add more watcher debugs

--- boot/worker/src/boot/watcher.clj
+++ boot/worker/src/boot/watcher.clj
@@ -58,6 +58,7 @@

 (defn- register-recursive
   [service path events]
+  (util/dbug "registering %s %s\n" path events)
   (register service path events)
   (doseq [dir (.listFiles (io/file path))]
     (when (.isDirectory dir)
@@ -92,13 +93,16 @@
                            changed (io/file dir (str (.context event)))
                            etype   (enum->kw service (.kind event))
                            dir?    (.isDirectory changed)]
-                       (cond
-                         (and dir? (= :create etype)) (doreg service changed)
-                         (not dir?) (.offer queue (.getPath changed)))))
-                 (if-not (.reset watch-key)
-                   (util/dbug "failed to reset watch key %s\n" (.watchable watch-key)))
-                 (recur)))))
-      Thread. .start)
+                       (util/dbug "event: %s %s %s\n" etype dir? (.watchable watch-key))
+                       (when (and dir? (= :create etype))
+                         (try (doreg service changed)
+                              (catch Throwable t
+                                (util/dbug "error registering %s: %s\n" (.watchable watch-key) t))))
+                       (.offer queue (.getPath changed))))
+                   (if-not (.reset watch-key)
+                     (util/dbug "failed to reset watch key %s\n" (.watchable watch-key)))
+                   (recur)))))
+        Thread. .start)
     service))

 (def ^:private watchers (atom {}))


Fix massage-rules doc

Fix massage-rules doc

Added missing mention of `:dispatch-fn`.

--- src/day8/re_frame/async_flow_fx.cljs
+++ src/day8/re_frame/async_flow_fx.cljs
@@ -59,7 +59,7 @@
 (defn massage-rules
   "Massage the supplied rules as follows:
     - replace `:when` keyword value with a function implementing the predicate
-    - ensure that only `:dispatch` or `:dispatch-n` is provided
+    - ensure that only one of `:dispatch`, `:dispatch-n` or `:dispatch-fn` is provided
     - add a unique :id, if one not already present"
   [rules]
   (->> rules


Identity for +

Identity for +

--- src/tick/alpha/api.clj
+++ src/tick/alpha/api.clj
@@ -29,8 +29,11 @@
 (defn tomorrow [] (core/tomorrow))
 (defn yesterday [] (core/yesterday))

-(defn + [arg & args]
-  (reduce #(core/+ %1 %2) arg args))
+(defn +
+  ([] Duration/ZERO)
+  ([arg] arg)
+  ([arg & args]
+   (reduce #(core/+ %1 %2) arg args)))

 (defn - [arg & args]
   (reduce #(core/- %1 %2) arg args))


Prefer Class/static

Prefer Class/static

--- src/tile_game/core.clj
+++ src/tile_game/core.clj
@@ -20,7 +20,7 @@
          (.setColor color)
          (.fillRect cx cy scale scale)
          (.setColor Color/BLACK)
-         (.setFont (Font. "Serif" (. Font PLAIN) 32)))
+         (.setFont (Font. "Serif" (Font/PLAIN) 32)))
        (when (> tile 0) (.drawString g (format "%d" tile)
                                      (int (+ cx (quot scale 2)))
                                      (int (+ cy (quot scale 2)))))))


fix(ccw.eclipse): IResourceCoercion & IPathCoercion protocols fault back to Eclipse platform adapter for objects of unknown type

--- ccw.core/src/clj/ccw/eclipse.clj
+++ ccw.core/src/clj/ccw/eclipse.clj
@@ -135,6 +135,9 @@
   nil
   (resource [this] nil)

+  Object
+  (resource [o] (adapter o IResource))
+
   IResource
   (resource [this] this)

@@ -169,6 +172,10 @@
 (extend-protocol IPathCoercion
   nil
   (path [_] nil)
+
+  Object
+  (path [o] (adapter o IPath))
+

   IPath
   (path [this] this)


fix formatting

fix formatting

--- src/bract/core/inducer.clj
+++ src/bract/core/inducer.clj
@@ -61,6 +61,8 @@

 ;; ----- inducers -----
+
+
 (defn set-verbosity
   "Set Bract verbosity flag and return context."
   [context]


factored out await-loop

factored out await-loop

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -109,6 +109,23 @@
                       (put! ch-out0 {:type "end"})
                       (initial-loop player0)))))))))))

+(defn await-loop [{:keys [waiter] :as player}]
+  (go-loop []
+    (alt!
+      ;; If the control channel is closed, dequeue and stop
+      ;; processing messages (note the lack of recur)
+      waiter
+      ([_]
+       (swap! awaiting dissoc (:uid player)))
+      ;; Otherwise ignore all messages of the client
+      (:ch-in player)
+      ([msg]
+       (if-not msg
+         (swap! awaiting dissoc (:uid player))
+         (do (put! (:ch-out player)
+                   {:type :ignored :msg msg :reason "waiting for match"})
+             (recur)))))))
+
 (defn match-once [{:keys [id] :as player0}]
   (if-let [player1 (->> (vals @awaiting)
                         (remove
@@ -124,23 +141,9 @@
         (swap! match-count update-in [#{(:id player0) (:id player1)}] (fnil inc 0))
         (game-loop (->> [player0 player1] (map #(dissoc % :waiter)))))
     ;; Nobody is available
-    (let [waiter (chan)]
-      (swap! awaiting assoc (:uid player0) (assoc player0 :waiter waiter))
-      (go-loop []
-        (alt!
-          ;; If the control channel is closed, dequeue and stop
-          ;; processing messages (note the lack of recur)
-          waiter
-          ([_]
-           (swap! awaiting dissoc (:uid player0)))
-          ;; Otherwise ignore all messages of the client
-          (:ch-in player0)
-          ([msg]
-           (if-not msg
-             (swap! awaiting dissoc (:uid player0))
-             (do (put! (:ch-out player0)
-                       {:type :ignored :msg msg :reason "waiting for match"})
-                 (recur)))))))))
+    (let [player0 (assoc player0 :waiter (chan))]
+      (swap! awaiting assoc (:uid player0) player0)
+      (await-loop player0))))

 (defn matcher-init []
   ;; This function initializes the matcher channel, which is needed


Simple map re-ordering

Simple map re-ordering

--- src/cylon/user/login.clj
+++ src/cylon/user/login.clj
@@ -26,10 +26,10 @@
   Lifecycle
   (start [component]
     (s/validate
-     {:session-store (s/protocol SessionStore)
+     {:user-store (s/protocol p/UserStore)
+      :session-store (s/protocol SessionStore)
       :renderer (s/protocol p/LoginFormRenderer)
       :password-verifier (s/protocol PasswordVerifier)
-      :user-store (s/protocol p/UserStore)
       :fields [FormField]
       :uri-context s/Str
       :*router s/Any ;; you can't get specific protocol of a codependency in start time


Handle games with braille-grade

Handle games with braille-grade

Some games are braillified and for that reason need some special
handling:
- collate all grades into one item
- add braille-grade to the item

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -322,7 +322,9 @@
       :ludo (-> item
                 (assoc-some
                  :game-description game-description
-                 :accompanying-material accompanying-material))
+                 :accompanying-material accompanying-material
+                 ;; some games are braillified
+                 :braille-grade (braille-grade-raw-to-braille-grade braille-grade)))

       :e-book item
       :musiknoten (-> item
@@ -392,9 +394,10 @@
   (let [braille-items (filter #(= (:format %) :braille) items)
         musiknoten-items (filter #(= (:format %) :musiknoten) items)
         taktile-items (filter #(= (:format %) :taktilesbuch) items)
-        others (remove #(#{:braille :musiknoten :taktilesbuch} (:format %)) items)]
+        spiele-items (filter #(= (:format %) :ludo) items)
+        others (remove #(#{:braille :musiknoten :taktilesbuch :ludo} (:format %)) items)]
     (concat
-     (mapcat collate-duplicate-items [braille-items musiknoten-items taktile-items])
+     (mapcat collate-duplicate-items [braille-items musiknoten-items taktile-items spiele-items])
      others)))

 (defn locale-compare


adding tid link

adding tid link

--- src/celestial/api/jobs.clj
+++ src/celestial/api/jobs.clj
@@ -127,5 +127,8 @@
      (let [page* (Integer/valueOf page) offset* (Integer/valueOf offset)
         {:keys [username]} (friend/current-authentication)
         {:keys [envs] :as user} (u/get-user username)]
-       (success {:jobs (es/paginate (* (- page* 1) offset*) (* page*  offset*) envs)})))
+       (success
+         {:jobs
+          (map #(update-in % [:_source] add-tid-link)
+            (es/paginate (* (- page* 1) offset*) (* page*  offset*) envs))})))
   )


* src/clj/cljs/core.clj: add min, max compiler macros. rem -> mod. add missing bit ops

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -17,8 +17,10 @@
                             with-loading-context with-local-vars with-open with-out-str with-precision with-redefs
                             satisfies?

-                            aget aset + - * / < <= > >= == zero? pos? neg? inc dec rem
-                            bit-not bit-and bit-or bit-xor bit-shift-left bit-shift-right]))
+                            aget aset
+                            + - * / < <= > >= == zero? pos? neg? inc dec max min mod
+                            bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set
+                            bit-test bit-shift-left bit-shift-right bit-xor]))

 (alias 'core 'clojure.core)

@@ -110,7 +112,17 @@
 (defmacro neg? [x]
   `(< ~x 0))

-(defmacro rem [num div]
+(defmacro max
+  ([x] x)
+  ([x y] (list 'js* "((~{} > ~{}) ? ~{} : ~{})" x y x y))
+  ([x y & more] `(max (max x y) ~@more)))
+
+(defmacro min
+  ([x] x)
+  ([x y] (list 'js* "((~{} < ~{}) ? ~{} : ~{})" x y x y))
+  ([x y & more] `(min (min x y) ~@more)))
+
+(defmacro mod [num div]
   (list 'js* "(~{} % ~{})" num div))

 (defmacro bit-not [x]
@@ -127,6 +139,19 @@
 (defmacro bit-xor
   ([x y] (list 'js* "(~{} ^ ~{})" x y))
   ([x y & more] `(bit-xor (bit-xor ~x ~y) ~@more)))
+
+(defmacro bit-and-not
+  ([x y] (list 'js* "(~{} & ~~{})" x y))
+  ([x y & more] `(bit-and-not (bit-and-not x y) ~@more)))
+
+(defmacro bit-clear [x n]
+  (list 'js* "(~{} & ~(1 << ~{}))" x n))
+
+(defmacro bit-flip [x n]
+  (list 'js* "(~{} ^ (1 << ~{}))" x n))
+
+(defmacro bit-test [x n]
+  (list 'js* "((~{} & (1 << ~{})) != 0)" x n))

 (defmacro bit-shift-left [x n]
   (list 'js* "(~{} << ~{})" x n))


Dissoc pump effects when trashing icebreakers.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -82,7 +82,7 @@
   ([state side card] (desactivate state side card nil))
   ([state side card keep-counter]
    (let [c (dissoc card :current-strength :abilities :rezzed :special :facedown)
-         c (if (= (:side c) "Runner") (dissoc c :installed :counter :rec-counter) c)
+         c (if (= (:side c) "Runner") (dissoc c :installed :counter :rec-counter :pump) c)
          c (if keep-counter c (dissoc c :counter :rec-counter :advance-counter))]
      (when-let [leave-effect (:leave-play (card-def card))]
        (when (or (= (:side card) "Runner") (:rezzed card))


Inject some fake roles temporarily

Inject some fake roles temporarily

--- src/clj/mdr2/ldap.clj
+++ src/clj/mdr2/ldap.clj
@@ -41,7 +41,8 @@
                    (map keyword)
                    (remove nil?)
                    set)
-        roles (conj (conj roles :admin) :it)] ; FIXME: this is a temporary workaround
+        roles (conj (conj roles :admin) :it) ; FIXME: this is a temporary workaround
+        ]
     (assoc user :roles roles)))

 (defn authenticate [username password & [attributes]]


refactor extraneous ifs to be whens

refactor extraneous ifs to be whens

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -18,7 +18,7 @@
                 (iterator-seq (.headerIterator http-resp)))))

 (defn- set-client-param [#^HttpClient client key val]
-  (when (not (nil? val))
+  (when (not (nil? val))
     (-> client
         (.getParams)
         (.setParameter key val))))
@@ -44,20 +44,20 @@
         (set-client-param ClientPNames/COOKIE_POLICY
                           CookiePolicy/BROWSER_COMPATIBILITY)
         (set-client-param ClientPNames/HANDLE_REDIRECTS false)
-        (set-client-param "http.socket.timeout" (and socket-timeout
-                                                     (Integer. socket-timeout)))
-        (set-client-param "http.connection.timeout" (and conn-timeout
-                                                         (Integer. conn-timeout))))
-      (if (nil? (#{"localhost" "127.0.0.1"} server-name))
+        (set-client-param "http.socket.timeout"
+                          (and socket-timeout (Integer. socket-timeout)))
+        (set-client-param "http.connection.timeout"
+                          (and conn-timeout (Integer. conn-timeout))))
+      (when (nil? (#{"localhost" "127.0.0.1"} server-name))
         (when-let [proxy-host (System/getProperty (str scheme ".proxyHost"))]
           (let [proxy-port (Integer/parseInt
                             (System/getProperty (str scheme ".proxyPort")))]
             (set-client-param http-client ConnRoutePNames/DEFAULT_PROXY
                               (HttpHost. proxy-host proxy-port)))))
       (let [http-url (str scheme "://" server-name
-                          (if server-port (str ":" server-port))
+                          (when server-port (str ":" server-port))
                           uri
-                          (if query-string (str "?" query-string)))
+                          (when query-string (str "?" query-string)))
             #^HttpRequest
             http-req (case request-method
                        :get    (HttpGet. http-url)
@@ -65,15 +65,15 @@
                        :put    (HttpPut. http-url)
                        :post   (HttpPost. http-url)
                        :delete (proxy-delete-with-body http-url))]
-        (if (and content-type character-encoding)
+        (when (and content-type character-encoding)
           (.addHeader http-req "Content-Type"
                       (str content-type "; charset=" character-encoding)))
-        (if (and content-type (not character-encoding))
+        (when (and content-type (not character-encoding))
           (.addHeader http-req "Content-Type" content-type))
         (.addHeader http-req "Connection" "close")
         (doseq [[header-n header-v] headers]
           (.addHeader http-req header-n header-v))
-        (if body
+        (when body
           (let [http-body (ByteArrayEntity. body)]
             (.setEntity #^HttpEntityEnclosingRequest http-req http-body)))
         (let [http-resp (.execute http-client http-req)


Fix channel state machines and add simple cache

Switch from go-loop to (go (while true …)) for building pipeline state
machine channels.

Add a cache for remembering saved results in order to limit HTTP
requests. (Currently the cache is a hash-map and doesn’t have a
replacement policy.)

--- src/cljs/app/app.cljs
+++ src/cljs/app/app.cljs
@@ -1,5 +1,6 @@
 (ns app.app
-  (:require [goog.dom :as dom]
+  (:require [goog.events :as events]
+            [goog.dom :as dom]
             [clojure.string :as string :refer [blank?]]
             [cljs.core.async :refer [<! >! put! close! chan
                                      timeout sliding-buffer]]
@@ -9,66 +10,25 @@
   (:require-macros [kioo.reagent :refer [defsnippet deftemplate]]
                    [cljs.core.async.macros :refer [go go-loop]]))

-(def data-url "data/beers-data.json")
+(def all-results-url "data/beers-2015.json")

 ; ElasticSearch API URL
 (def query-url "http://168.235.155.245/beers/2015/_search")
+;(def query-url "search_test.json")

 ; Application state
-(def state (reagent/atom {:results {}}))
+(def state (reagent/atom {:all-results {} :results {} :cache {}}))

-(defn init-state []
+(defn update-results [results]
+  (swap! state assoc :results results))
+
+(defn update-cache [key new-results]
+  (swap! state assoc-in [:cache key] new-results))
+
+(defn load-all-results [url]
   (go
-    (swap! state assoc :results
-      (get (<! (http/get data-url)) :body))))
-
-(defn get-results [in]
-  (let [out (chan)]
-    (go-loop []
-      (>! out (<! (http/get query-url {:query-params {"q" (<! in)}}))))
-    out))
-
-(defn extract-hits [in]
-  (let [out (chan)]
-    (go-loop []
-      (>! out (get-in (<! in) [:body :hits :hits])))
-    out))
-
-(defn flatten-structure [in]
-  (let [out (chan)]
-    (go-loop []
-      (>! out (for [el (<! in)]
-                (get el :_source))))
-    out))
-
-(defn update-results-state [in]
-  (go-loop []
-    (swap! state assoc :results (<! in))))
-
-(defn throttle [in ms-delay]
-  (let [out (chan)]
-    (go-loop []
-      ; Take from the input channel and pass through.
-      (>! out (<! in))
-
-      ; Park while trying to take from an unused channel. The channel receives
-      ; no input, and will time out, delaying the above take from the input
-      ; channel.
-      (<! (timeout ms-delay)))
-    out))
-
-; Process pipeline entry point
-(def query-chan (chan (sliding-buffer 1)))
-(def throttled-query-chan (throttle query-chan 1000))
-
-; Rest of process pipeline
-(def get-results-out (get-results throttled-query-chan))
-(def extract-hits-out (extract-hits get-results-out))
-(def flatten-structure-out (extract-hits extract-hits-out))
-(update-results-state flatten-structure-out)
-
-(def second-chan (chan))
-(def second-path (update-results-state second-chan))
+    (swap! state assoc :all-results (:body (<! (http/get url))))
+    (update-results (:all-results @state))))

 ; Templating
 (def labels
@@ -79,19 +39,6 @@
    :quality-of-evidence "Quality Of Evidence"
    :strength-of-recommendation "Strength of Recommendation"
    :evidence "Evidence"})
-
-; (defsnippet result-data "templates/results.html" [:.list-row] [[k v]]
-;   {[:.list-row] (kioo/content [:li (k labels)]
-;                               [:li v])})
-;
-; (defsnippet result-card "templates/results.html" [:.card] [results]
-;   {[:.list-column] (kioo/content [:li
-;                                    [:ul {:class "list-row"}
-;                                      (map result-data results)]])})
-;
-; (deftemplate result-cards "templates/results.html" []
-;   {[:.cards] (kioo/content (map result-card
-;                              (:results @state)))})

 (defsnippet result-data "templates/results.html" [:.row] [[k v]]
   {[:.row] (kioo/content [:li (k labels)] [:li v])})
@@ -104,41 +51,94 @@
                              (:results @state)))})

 (deftemplate page "index.html" []
-  {[:.search-field] (kioo/listen :on-key-down
-                      (fn [_]
-                        (let [input (.-value (dom/getElement "search-field"))]
-                          (if (blank? input)
-                            (init-state)
-                            (put! query-chan input)))))
+  {[:.results] (kioo/content (result-cards))})

-   [:.test-button] (kioo/listen :on-click
-                     (fn [_]
-                       (.log js/console (clj->js (:results @state)))))
+; Pipelines

-   [:.test-state-push] (kioo/listen :on-click
-                         (fn [_]
-                           (put! second-chan
-                             [{
-                               :category-drugs "-generation antihistamines: Brompheniramine, Carbinoxamine, Chlorpheniramine, Clemastine, Cyproheptadine, Dexbrompheniramine, Dexchlorpheniramine, Dimenhydrinate, Diphenhydramine (oral), Doxylamine, Hydroxyzine, Meclizine, Promethazine, Triprolidine",
-                               :organ-system "Anticholinergics",
-                               :rationale "Highly anticholinergic; clearance reduced with advanced age, and tolerance develops when used as hypnotic; risk of confusion, dry mouth, constipation, and other anticholinergic effects or toxicity. Use of diphenhydramine in situations such as acute treatment of severe allergic reaction may be appropriate",
-                               :recommendation "Avoid",
-                               :quality-of-evidence "Moderate",
-                               :strength-of-recommendation "Strong",
-                               :evidence "2015 Criteria: Duran 2013, Fox 2014, Kalisch Ellet 2014. From previous criteria: Agostini 2001, Boustani 2007, Guaiana 2010, Han 2001, Rudolph 2008"
-                              },
-                              {
-                               :category-drugs "Antiparkinsonian agents: Benztropine (oral), Trihexyphenidyl",
-                               :organ-system "Anticholinergics",
-                               :rationale "Not recommended for prevention of extrapyramidal symptoms with antipsychotics; more effective agents available for treatment of Parkinson disease.",
-                               :recommendation "Avoid",
-                               :quality-of-evidence "Moderate",
-                               :strength-of-recommendation "Strong",
-                               :evidence "Rudolph 2008"
-                              }])))
+; Query pipeline
+(defn throttle [in ms-delay]
+  (let [out (chan)]
+    (go (while true
+      ; Take from the input channel and pass through.
+      (>! out (<! in))

-   [:.results] (kioo/content (result-cards))})
+      ; Park while trying to take from an unused channel. This channel receives
+      ; no input, and will park until timed out, delaying the above take from
+      ; the input channel as the user types.
+      (<! (timeout ms-delay))))
+    out))
+
+(defn get-results [in]
+  (let [out (chan)]
+    (go (while true
+      (let [[url search-text] (<! in)
+            response (<! (http/get url {:query-params {"q" search-text}}))]
+        (>! out (vector search-text response)))))
+    out))
+
+(defn extract-hits [in]
+  (let [out (chan)]
+    (go (while true
+      (let [[search-text mid-results] (<! in)
+            output (get-in mid-results [:body :hits :hits])]
+        (>! out (vector search-text output)))))
+    out))
+
+(defn flatten-structure [in]
+  (let [out (chan)]
+    (go (while true
+      (let [[search-text mid-results] (<! in)
+            output (vec (map #(:_source %) mid-results))]
+        (>! out (vector search-text output)))))
+    out))
+
+(defn update-query-results [in]
+  (go (while true
+    (let [[search-text query-results] (<! in)]
+      (update-cache search-text query-results)
+      (update-results query-results)))))
+
+; Query process pipeline entry point
+; Sliding buffer is used to complete throttling
+(def query-chan (chan (sliding-buffer 1)))
+(def throttled-query-chan (throttle query-chan 3000))
+(def get-results-out (get-results throttled-query-chan))
+(def extract-hits-out (extract-hits get-results-out))
+(def flatten-structure-out (flatten-structure extract-hits-out))
+(update-query-results flatten-structure-out)
+
+; Cache pipeline
+(defn update-cache-results [in]
+  (go (while true
+    (let [query-result (<! in)]
+      (update-results (get (:cache @state) query-result))))))
+
+(def cache-chan (chan))
+(update-cache-results cache-chan)
+
+; Creates and returns a channel to listen to events specified by type parameter
+(defn listen [el type]
+  (let [out (chan)]
+    (events/listen el type #(put! out %))
+    out))
+
+(defn search-field []
+  (dom/getElementByClass "search-field"))
+
+(defn listen-search-input []
+  (let [input (listen (search-field) "keyup")]
+    (go (while true
+      (<! input)
+
+      (let [cache (:cache @state)
+            query-text (.-value (search-field))]
+        (if (blank? query-text)
+          (update-results (:all-results @state))
+          (if (contains? cache query-text)
+            (put! cache-chan query-text)
+            (put! query-chan (vector query-url query-text)))))))))

 (defn init []
-  (init-state)
-  (reagent/render-component [page] (.-body js/document)))
+  (load-all-results all-results-url)
+  (reagent/render-component [page] (.-body js/document))
+  (listen-search-input))


New test for 0 months entry

New test for 0 months entry

--- test/clj_calendar/format_datetime_test.clj
+++ test/clj_calendar/format_datetime_test.clj
@@ -132,6 +132,14 @@
               "100 months ago" (format-month 100 2)
               "100 months ago" (format-month 100 100))))

+(deftest test-format-month-special-cases
+    "Check the function clj-calendar.format-datetime/format-month."
+    (testing "the function clj-calendar.format-datetime/format-month."
+        (are [x y] (= x y)
+              "one day ago"    (format-month 0 1)
+              "2 days ago"     (format-month 0 2)
+              "100 days ago"   (format-month 0 100))))
+
 (deftest test-format-day-1
     "Check the function clj-calendar.format-datetime/format-day."
     (testing "the function clj-calendar.format-datetime/format-day."


Delete unused variables

Delete unused variables

--- test/freecoin/test/handlers/sign_in.clj
+++ test/freecoin/test/handlers/sign_in.clj
@@ -35,11 +35,6 @@
             [freecoin.test-helpers.store :as test-store]
             [freecoin.email-activation :as email-activation]
             [taoensso.timbre :as log]))
-
-(def client-id "CLIENT_ID")
-(def client-secret "CLIENT_SECRET")
-(def callback-uri "CALLBACK_URI")
-(def public-key "PUBLICK_KEY") ;; TODO: load this from jwk file

 (def absolute-path (partial routes/absolute-path))


Improve behavior of nav tabs on images page.

--- src/uxbox/main/ui/dashboard/images.cljs
+++ src/uxbox/main/ui/dashboard/images.cljs
@@ -138,7 +138,7 @@
         (tr "ds.num-elements" (t/c num-images))]])))

 (mx/defc nav-section
-  {:mixins [mx/static mx/reactive]}
+  {:mixins [mx/static]}
   [type selected colls]
   (let [own? (= type :own)
         builtin? (= type :builtin)
@@ -166,14 +166,15 @@
   (let [own? (= type :own)
         builtin? (= type :builtin)]
     (letfn [(select-tab [type]
-              (let [xf (comp
-                        (map second)
-                        (filter #(= type (:type %))))
-                    colls (->> (into [] xf colls)
-                               (sort-by :name))]
-                (if-let [item (first colls)]
-                  (rs/emit! (di/select-collection type (:id item)))
-                  (rs/emit! (di/select-collection type)))))]
+              (if own?
+                (rs/emit! (di/select-collection type))
+                (let [coll (->> (map second colls)
+                                 (filter #(= type (:type %)))
+                                 (sort-by :name)
+                                 (first))]
+                  (if coll
+                    (rs/emit! (di/select-collection type (:id coll)))
+                    (rs/emit! (di/select-collection type))))))]
       [:div.library-bar
        [:div.library-bar-inside
         [:ul.library-tabs