Fix some more generative distinct element failures.

--- src/blocks/store/tests.clj
+++ src/blocks/store/tests.clj
@@ -66,14 +66,21 @@
   (gen/elements (vals blocks)))

+(defn- gen-sub-seq
+  "Generate subsequences of the entries in the given sequence, returning some of
+  the elements in the same order as given."
+  [xs]
+  (gen/fmap
+    (fn select
+      [bools]
+      (sequence (comp (filter first) (map second)) (map vector bools xs)))
+    (gen/vector gen/boolean (count xs))))
+
+
 (defn- gen-sub-map
   "Generate subsets of the entries in the given map."
   [m]
-  (gen/fmap
-    (fn select
-      [bools]
-      (into {} (comp (filter first) (map second)) (map vector bools m)))
-    (gen/vector gen/boolean (count m))))
+  (gen/fmap (partial into {}) (gen-sub-seq (seq m))))

 (defop StatBlock
@@ -102,16 +109,12 @@

   (gen-args
     [blocks]
-    [(gen/fmap
-       (fn select
-         [[opts selection]]
-         (select-keys opts selection))
-       (gen/tuple
-         (gen/hash-map
-           :algorithm (gen/elements (keys digest/functions))
-           :after (gen/fmap hex/encode (gen/not-empty gen/bytes)) ; TODO: pick prefixes
-           :limit (gen/large-integer* {:min 1, :max (inc (count blocks))}))
-         (gen/set (gen/elements #{:algorithm :after :limit}))))])
+    [(gen/bind
+       (gen/hash-map
+         :algorithm (gen/elements (keys digest/functions))
+         :after (gen/fmap hex/encode (gen/not-empty gen/bytes)) ; TODO: pick prefixes
+         :limit (gen/large-integer* {:min 1, :max (inc (count blocks))}))
+       gen-sub-map)])

   (apply-op
     [this store]


clean up differences between node and html reloading

--- support/src/figwheel/client/file_reloading.cljs
+++ support/src/figwheel/client/file_reloading.cljs
@@ -14,7 +14,7 @@
    [cljs.core.async.macros :refer [go go-loop]])
   (:import [goog]))

-(declare queued-file-reload reload-file* resolve-ns)
+(declare queued-file-reload)

 ;; you can listen to this event easily like so:
 ;; document.body.addEventListener("figwheel.js-reload", function (e) {console.log(e.detail);} );
@@ -45,25 +45,20 @@
   (dev-assert (string? url))
   (.makeUnique (guri/parse url)))

-(defn ns-to-js-file [ns]
+(defn name->path [ns]
   (dev-assert (string? ns))
-  (str (string/replace ns "." "/") ".js"))
-
+  (aget js/goog.dependencies_.nameToPath ns))
+
+;; this is pretty simple, not sure how brittle it is
 (defn fix-node-request-url [url]
+  (dev-assert (string? url))
   (if (gstring/startsWith url "../")
     (string/replace url "../" "")
     (str "goog/" url)))

-(def resolve-ns
-  (condp = (utils/host-env?)
-    :node
-    (fn [ns]
-      (dev-assert (string? ns))
-      (fix-node-request-url (aget js/goog.dependencies_.nameToPath ns)))
-    (fn [ns]
-      (dev-assert (string? ns))
-      (str (utils/base-url-path) "goog/"
-           (aget js/goog.dependencies_.nameToPath ns)))))
+;; this matches goog behavior in url resolution should actually just
+;; use that code
+(defn resolve-ns [ns] (str goog/basePath (name->path ns)))

 (defn bootstrap-goog-base
   "Reusable browser REPL bootstrapping. Patches the essential functions
@@ -81,13 +76,15 @@
     ;; reload scenarios we simply delete entries from the correct
     ;; private locations
     (set! (.-CLOSURE_IMPORT_SCRIPT goog/global) queued-file-reload)
+    ;; TODO reload-all doesn't work
     (set! (.-require js/goog)
           (fn [src reload]
             (when (= reload "reload-all")
               (set! (.-cljsReloadAll_ js/goog) true))
             (let [reload? (or reload (.-cljsReloadAll__ js/goog))]
               (when reload?
-                (let [path (aget js/goog.dependencies_.nameToPath src)]
+                (let [path (name->path
+                                 src)]
                   (gobj/remove js/goog.dependencies_.visited path)
                   (gobj/remove js/goog.dependencies_.written path)
                   (gobj/remove js/goog.dependencies_.written
@@ -100,21 +97,13 @@
 (defn patch-goog-base []
   (defonce bootstrapped-cljs (do (bootstrap-goog-base) true)))

-(defmulti resolve-url :type)
-(defmethod resolve-url :default [{:keys [file]}] file)
-(defmethod resolve-url :namespace [{:keys [namespace]}]
-  (dev-assert (string? namespace))
-  (resolve-ns namespace))
-
-
 (def reload-file*
   (condp = (utils/host-env?)
     :node
     (fn [request-url callback]
       (dev-assert (string? request-url) (not (nil? callback)))
       (let [root (string/join "/" (reverse (drop 2 (reverse (string/split js/__dirname "/")))))
-            path (str root "/" request-url)]
-        (prn request-url)
+            path (str root "/" (fix-node-request-url request-url))]
         (aset (.-cache js/require) path nil)
         (callback (try
                     (js/require path)
@@ -131,9 +120,7 @@
     (fn [a b] (throw "Reload not defined for this platform"))))

 (defn reload-file [{:keys [request-url] :as file-msg} callback]
-  (dev-assert (string? request-url)
-              (not (nil? callback))
-              (namespace-file-map? file-msg))
+  (dev-assert (string? request-url) (not (nil? callback)))
   (utils/debug-prn (str "FigWheel: Attempting to load " request-url))
   (reload-file* request-url
                 (fn [success?]
@@ -150,6 +137,8 @@

 (defonce on-load-callbacks (atom {}))

+(defonce dependencies-loaded (atom []))
+
 (defn blocking-load [url]
   (let [out (chan)]
     (reload-file
@@ -163,19 +152,21 @@
   (go-loop []
     (when-let [url (<! reload-chan)]
       (let [file-msg (<! (blocking-load url))]
-        (when-let [callback (get @on-load-callbacks url)]
-          (callback file-msg))
+        (if-let [callback (get @on-load-callbacks url)]
+          (callback file-msg)
+          (swap! dependencies-loaded conj file-msg))
         (recur)))))

-(defn queued-file-reload [url]
-  (put! reload-chan url))
-
-(defn require-with-callback [{:keys [request-url] :as file-msg} callback]
-  (swap! on-load-callbacks assoc request-url
-         (fn [file-msg'] (swap! on-load-callbacks dissoc request-url)
-           (apply callback [(merge file-msg (select-keys file-msg' [:loaded-file]))])))
-  ;; we are forcing reload here
-  (js/goog.require (name (:namespace file-msg)) true))
+(defn queued-file-reload [url] (put! reload-chan url))
+
+(defn require-with-callback [{:keys [namespace] :as file-msg} callback]
+  (let [request-url (resolve-ns namespace)]
+    (swap! on-load-callbacks assoc request-url
+           (fn [file-msg']
+             (swap! on-load-callbacks dissoc request-url)
+             (apply callback [(merge file-msg (select-keys file-msg' [:loaded-file]))])))
+    ;; we are forcing reload here
+    (js/goog.require (name namespace) true)))

 (defn reload-file? [{:keys [namespace meta-data] :as file-msg}]
   (dev-assert (namespace-file-map? file-msg))
@@ -188,25 +179,22 @@
       ;; might want to use .-visited here
       (goog/isProvided__ (name namespace))))))

-(def js-reload*
-  (if (= :node (utils/host-env?))
-    reload-file
-    require-with-callback))
-
 (defn js-reload [{:keys [request-url namespace] :as file-msg} callback]
   (dev-assert (namespace-file-map? file-msg))
   (if (reload-file? file-msg)
-    (js-reload* file-msg callback)
+    (require-with-callback file-msg callback)
     (do
       (utils/debug-prn (str "Figwheel: Not trying to load file " request-url))
       (apply callback [file-msg]))))

 (defn reload-js-file [file-msg]
   (let [out (chan)]
-    (js/setTimeout #(js-reload file-msg (fn [url]
-                                          (patch-goog-base)
-                                          (put! out url)
-                                          (close! out))) 0)
+    (js-reload
+     file-msg
+     (fn [url]
+       (patch-goog-base)
+       (put! out url)
+       (close! out)))
     out))

 (defn load-all-js-files
@@ -219,16 +207,6 @@
             (recur fs))
         (close! out)))
     (async/into [] out)))
-
-(defn add-request-url [{:keys [url-rewriter] :as opts} {:keys [file] :as file-msg}]
-  (let [resolved-path (resolve-url file-msg)]
-    (assoc file-msg :request-url
-           (if url-rewriter
-             (url-rewriter resolved-path)
-             resolved-path))))
-
-(defn add-request-urls [opts files]
-  (map (partial add-request-url opts) files))

 (defn eval-body [{:keys [eval-body file]} opts]
   (when (and eval-body (string? eval-body))
@@ -252,23 +230,29 @@
       (when (not-empty eval-bodies)
         (doseq [eval-body-file eval-bodies]
           (eval-body eval-body-file opts))))
-
+    (reset! dependencies-loaded (list))
     (let [all-files (filter #(and (:namespace %)
                                   (not (:eval-body %)))
                             files)
-          files'  (add-request-urls opts all-files)
-          res'    (<! (load-all-js-files files'))
+          res'    (<! (load-all-js-files all-files))
           res     (filter :loaded-file res')
-          files-not-loaded  (filter #(not (:loaded-file %)) res')]
+          files-not-loaded  (filter #(not (:loaded-file %)) res')
+          dependencies-that-loaded (filter :loaded-file @dependencies-loaded)]
+      (when (not-empty dependencies-that-loaded)
+        (utils/log :debug "Figwheel: loaded these dependencies")
+        (utils/log (pr-str (map (fn [{:keys [request-url]}]
+                                  (string/replace request-url goog/basePath ""))
+                                (reverse dependencies-that-loaded)))))
       (when (not-empty res)
         (utils/log :debug "Figwheel: loaded these files")
         (utils/log (pr-str (map (fn [{:keys [namespace file]}]
                                   (if namespace
-                                    (ns-to-js-file namespace)
+                                    (name->path (name namespace))
                                     file)) res)))
         (js/setTimeout #(do
                           (on-jsload-custom-event res)
                           (apply on-jsload [res])) 10))
+
       (when (not-empty files-not-loaded)
         (utils/log :debug "Figwheel: NOT loading these files ")
         (let [{:keys [figwheel-no-load not-required]}
@@ -348,15 +332,13 @@
          (.insertBefore parent klone (.-nextSibling orig-link)))
        (js/setTimeout #(.removeChild parent orig-link) 300))))

-(defn reload-css-file [{:keys [file request-url] :as f-data}]
+(defn reload-css-file [{:keys [file] :as f-data}]
   (if-let [link (get-correct-link f-data)]
     (add-link-to-doc link (clone-link link (.-href link)))
-    (add-link-to-doc (create-link (or request-url file)))))
+    (add-link-to-doc (create-link file))))

 (defn reload-css-files [{:keys [on-cssload] :as opts} files-msg]
   (when (utils/html-env?)
-    (doseq [f (add-request-urls opts (:files files-msg))]
-      (reload-css-file f))
-    (go
-      (<! (timeout 100))
-      (on-cssload (:files files-msg)))))
+    (doseq [f (:files files-msg)] (reload-css-file f))
+    (js/setTimeout #(on-cssload (:files files-msg)) 100)))
+


fix typo in version description

fix typo in version description

--- src/cake/tasks/version.clj
+++ src/cake/tasks/version.clj
@@ -39,7 +39,7 @@
     new-version))

 (deftask version
-  "Display the project version. Use bump [--major --minor --patch --version] to increment."
+  "Display project version. Use 'bump [--major --minor --patch --snapshot]' to increment."
   (if-let [arg (first (:version *opts*))]
     (println (:artifact-id *project*)
              (:version *project*)


fixed small bug

fixed small bug

--- server/src/gratefulplace/controllers/users.clj
+++ server/src/gratefulplace/controllers/users.clj
@@ -45,6 +45,7 @@
     {}))

 (defshow
+  [params]
   :exists? (exists? (record (id) (show-opts params)))
   :return record-in-ctx)


Indent issue number for issue 5 2mm to the right

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -493,7 +493,8 @@
   ;; circle. Somehow this doesn't seem to pan out, so we resort to
   ;; fidget with the indent for each issue.
   {3 "143mm"
-   4 "140mm"})
+   4 "140mm"
+   5 "142mm"})

 (defn- coverpage-recto
   "Return a hiccup style sexp for the recto (the front) of the


bump cljs version to 2740

bump cljs version to 2740

--- src/leiningen/new/reagent_liveedit/project.clj
+++ src/leiningen/new/reagent_liveedit/project.clj
@@ -15,7 +15,7 @@
                  [cljsjs/react "0.12.2-5"]
                  [garden "1.2.5"]
                  [secretary "1.2.1"]
-                 [org.clojure/clojurescript "0.0-2727" :scope "provided"]
+                 [org.clojure/clojurescript "0.0-2740" :scope "provided"]
                  [org.clojure/core.async "0.1.346.0-17112a-alpha"]
                  [com.cemerick/piggieback "0.1.5"]
                  [weasel "0.5.0"]


(TK-202) Refactor HUP test to call restart-tk-apps

Unfortunately, jenkins clients swallow up HUP signals, so the previous
HUP test consistently fails in jenkins, as the signal never gets to
clojure. This commit addresses this by calling directly into the
function that is invoked by the HUP signal, which is as close as we can
get for the moment.

--- test/puppetlabs/trapperkeeper/services_test.clj
+++ test/puppetlabs/trapperkeeper/services_test.clj
@@ -8,12 +8,10 @@
               with-app-with-empty-config]]
             [schema.test :as schema-test]
             [puppetlabs.kitchensink.testutils.fixtures :refer [with-no-jvm-shutdown-hooks]]
-            [beckon]
             [puppetlabs.trapperkeeper.internal :as internal]
             [puppetlabs.trapperkeeper.testutils.logging :refer [with-test-logging]]
             [puppetlabs.trapperkeeper.core :as tk]
-            [puppetlabs.kitchensink.testutils :as ks-testutils]
-            [clojure.tools.logging :as log])
+            [puppetlabs.kitchensink.testutils :as ks-testutils])
   (:import (java.util.concurrent ExecutionException)))

 (use-fixtures :once schema-test/validate-schemas with-no-jvm-shutdown-hooks)
@@ -151,10 +149,10 @@
         (is (= [:init-service1 :init-service2 :init-service3
                 :start-service1 :start-service2 :start-service3]
                @call-seq))
-        (internal/register-sighup-handler [app])
-        (log/debugf "About to HUP the app. Hold onto your butts!")
-        (beckon/raise! "HUP")
-        (log/debugf "Have HUPped the app. Did anything happen yet?")
+        ;; It would be preferrable to send a HUP here, but jenkins clients
+        ;; swallow the HUP signal, which makes the test fail. So instead we
+        ;; just call the thing that the signal would have caused to be called.
+        (internal/restart-tk-apps [app])
         (let [start (System/currentTimeMillis)]
           (while (and (not= (count @call-seq) 15)
                      (< (- (System/currentTimeMillis) start) 1000))


Display system properties as lists when they are a path

Fixes #6

--- src/io/aviso/twixt/exceptions.clj
+++ src/io/aviso/twixt/exceptions.clj
@@ -4,11 +4,14 @@
         hiccup.page
         ring.util.response)
   (:import [clojure.lang APersistentMap Sequential PersistentHashMap$ArrayNode$Seq PersistentHashMap]
-           [java.util Map])
+           [java.util Map]
+           (java.util.regex Pattern))
   (:require [clojure.string :as s]
             [io.aviso
              [exception :as exception]
              [twixt :as t]]))
+
+(def ^:private path-separator (System/getProperty "path.separator"))

 (defn- exception-message [exception]
   (or (.getMessage exception)
@@ -154,6 +157,29 @@
     (map (partial single-exception->markup twixt))
     (apply str)))

+(defn- is-path?
+  [^String k ^String v]
+  (and (.endsWith k ".path")
+       (.contains v path-separator)))
+
+(defn- split-string [^String s ^String sep]
+  (s/split s (-> sep Pattern/quote Pattern/compile)))
+
+(defn- path->markup [^String path]
+  `[:ul
+    ~@(for [v (.split path path-separator)]
+        [:li v])])
+
+(defn- sysproperties->markup
+  []
+  (let [props (System/getProperties)]
+    [:dl
+     (apply concat
+            (for [k (-> props keys sort)
+                  :let [v (.get props k)]]
+              [[:dt k]
+               [:dd (if (is-path? k v) (path->markup v) v)]]))]))
+
 (defn build-report
   "Builds an HTML exception report (as a string).

@@ -183,7 +209,7 @@
         (to-markup request)

         [:h3 "System Properties"]
-        (to-markup (System/getProperties))
+        (sysproperties->markup)
         ]
        (apply include-js (t/get-asset-uris twixt
                                            "bootstrap3/js/jquery.js"


get-config modified to return a lazy value

--- src/clj/hellhound/core.clj
+++ src/clj/hellhound/core.clj
@@ -54,9 +54,21 @@
       (load-runtime-configuration)
       config-data)))

+(defn- default-value-for
+  [key-names]
+  (delay (get-in config/default-config)))
+
+(defn- derefiy
+  [value]
+  (if (delay? value)
+    value
+    (delay value)))
+
 (defn get-config
   "Fetch the given key (or nested keys) from the environment config of
   the project other. Returns the default value from hellhound.config"
   [& keys]
-  (or (get-in (application-config) keys)
-      (get-in config/default-config keys)))
+  (let [app-value (get-in (application-config) keys)]
+    (if (nil? app-value)
+      (default-value-for keys)
+      (derefiy app-value))))


tests for Asteroid Belt, Cortex Lock, Enigma, Lockdown, NEXT Bronze

--- src/clj/test/cards-ice.clj
+++ src/clj/test/cards-ice.clj
@@ -32,6 +32,36 @@
       (is (= (get-in @state [:corp :discard 0 :title]) "Architect"))
       (is (= (get-in @state [:corp :discard 1 :title]) "Architect")))))

+(deftest asteroid-belt
+  "Asteroid Belt - Space ICE rez cost reduced by 3 credits per advancement"
+  (do-game
+    (new-game (default-corp [(qty "Asteroid Belt" 1)])
+              (default-runner))
+    (core/gain state :corp :credit 5)
+    (play-from-hand state :corp "Asteroid Belt" "HQ")
+    (let [ab (get-in @state [:corp :servers :hq :ices 0])]
+      (core/advance state :corp {:card (refresh ab)})
+      (core/advance state :corp {:card (refresh ab)})
+      (is (= 8 (:credit (get-corp))))
+      (is (= 2 (:advance-counter (refresh ab))))
+      (core/rez state :corp (refresh ab))
+      (is (= 5 (:credit (get-corp))) "Paid 3 credits to rez; 2 advancments on Asteroid Belt"))))
+
+(deftest cortex-lock
+  "Cortex Lock - Do net damage equal to Runner's unused memory"
+  (do-game
+    (new-game (default-corp [(qty "Cortex Lock" 1)])
+              (default-runner [(qty "Corroder" 2) (qty "Sure Gamble" 3)]))
+    (play-from-hand state :corp "Cortex Lock" "HQ")
+    (take-credits state :corp)
+    (let [cort (get-in @state [:corp :servers :hq :ices 0])]
+      (play-from-hand state :runner "Corroder")
+      (is (= 3 (:memory (get-runner))))
+      (core/click-run state :runner {:server "HQ"})
+      (core/rez state :corp cort)
+      (card-ability state :corp cort 0)
+      (is (= 3 (count (:discard (get-runner)))) "Runner suffered 3 net damage"))))
+
 (deftest curtain-wall
   "Curtain Wall - Strength boost when outermost ICE"
   (do-game
@@ -46,6 +76,43 @@
       (let [paper (get-in @state [:corp :servers :hq :ices 1])]
         (core/rez state :corp paper)
         (is (= 6 (:current-strength (refresh curt))) "Curtain Wall back to default 6 strength")))))
+
+(deftest enigma
+  "Enigma - Force Runner to lose 1 click if able"
+  (do-game
+    (new-game (default-corp [(qty "Enigma" 1)])
+              (default-runner))
+    (play-from-hand state :corp "Enigma" "HQ")
+    (take-credits state :corp)
+    (let [enig (get-in @state [:corp :servers :hq :ices 0])]
+      (core/click-run state :runner {:server "HQ"})
+      (is (= 3 (:click (get-runner))))
+      (core/rez state :corp enig)
+      (card-ability state :corp enig 0)
+      (is (= 2 (:click (get-runner))) "Runner lost 1 click"))))
+
+(deftest lockdown
+  "Lockdown - Prevent Runner from drawing cards for the rest of the turn"
+  (do-game
+    (new-game (default-corp [(qty "Lockdown" 1)])
+              (default-runner [(qty "Diesel" 2) (qty "Sure Gamble" 3)]))
+    (play-from-hand state :corp "Lockdown" "R&D")
+    (take-credits state :corp)
+    (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+    (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+    (core/move state :runner (find-card "Sure Gamble" (:hand (get-runner))) :deck)
+    (let [lock (get-in @state [:corp :servers :rd :ices 0])]
+      (core/click-run state :runner {:server "R&D"})
+      (core/rez state :corp lock)
+      (card-ability state :corp lock 0)
+      (core/no-action state :corp nil)
+      (core/successful-run state :runner nil)
+      (play-from-hand state :runner "Diesel")
+      (is (= 1 (count (:hand (get-runner)))) "No cards drawn")
+      (take-credits state :runner)
+      (take-credits state :corp)
+      (play-from-hand state :runner "Diesel")
+      (is (= 3 (count (:hand (get-runner)))) "New turn ends prevention; remaining 3 cards drawn from Stack"))))

 (deftest lotus-field-unlowerable
   "Lotus Field strength cannot be lowered"
@@ -97,6 +164,27 @@
         (is (= true (has? (refresh wend) :subtype "Code Gate")) "Wendigo gained Code Gate")
         (is (= 4 (:current-strength (refresh wend))) "Wendigo returned to normal 4 strength")))))

+(deftest next-bronze
+  "NEXT Bronze - Add 1 strength for every rezzed NEXT ice"
+  (do-game
+    (new-game (default-corp [(qty "NEXT Bronze" 2) (qty "NEXT Silver" 1)])
+              (default-runner))
+    (core/gain state :corp :credit 2)
+    (play-from-hand state :corp "NEXT Bronze" "HQ")
+    (play-from-hand state :corp "NEXT Bronze" "R&D")
+    (play-from-hand state :corp "NEXT Silver" "Archives")
+    (let [nb1 (get-in @state [:corp :servers :hq :ices 0])
+          nb2 (get-in @state [:corp :servers :rd :ices 0])
+          ns1 (get-in @state [:corp :servers :archives :ices 0])]
+      (core/rez state :corp nb1)
+      (is (= 1 (:current-strength (refresh nb1))) "NEXT Bronze at 1 strength: 1 rezzed NEXT ice")
+      (core/rez state :corp nb2)
+      (is (= 2 (:current-strength (refresh nb1))) "NEXT Bronze at 2 strength: 2 rezzed NEXT ice")
+      (is (= 2 (:current-strength (refresh nb2))) "NEXT Bronze at 2 strength: 2 rezzed NEXT ice")
+      (core/rez state :corp ns1)
+      (is (= 3 (:current-strength (refresh nb1))) "NEXT Bronze at 3 strength: 3 rezzed NEXT ice")
+      (is (= 3 (:current-strength (refresh nb2))) "NEXT Bronze at 3 strength: 3 rezzed NEXT ice"))))
+
 (deftest special-offer-trash-ice-during-run
   "Special Offer trashes itself and updates the run position"
   (do-game


cljs/skyport.core: Add name label over players

This is to more easily identify the differnt players on the map. Later
we probably want to use colour as well.

--- src/cljs/skyport/core.cljs
+++ src/cljs/skyport/core.cljs
@@ -324,7 +324,10 @@
           [:circle {:fill "blue"
                     :cx x
                     :cy y
-                    :r (/ TILE-SIZE 2)}]])))))
+                    :r (/ TILE-SIZE 2)}]
+          [:text {:x x
+                  :y (- y TILE-SIZE -12)}
+           name]])))))

 (defn world-view [state owner]
   (reify


remove link b/w checkbox and label to correct click hitbox

--- src/cljs/todomvc/core.cljs
+++ src/cljs/todomvc/core.cljs
@@ -75,14 +75,11 @@
   (let [editing (atom false)]
     (fn [{:keys [id text done]}]
       [:li {:class (if @editing "editing")}
-       (let [checkbox-id (str "check" id)]
-         [:div
-          [:input {:type "checkbox"
-                   :id checkbox-id
-                   :on-change #(toggle! id)}]
-          [:label {:for checkbox-id
-                   :on-double-click #(reset! editing true)} text]
-          [:a.destroy {:on-click #(remove-todo! id)}]])
+       [:div.todo-entry
+        [:input {:type "checkbox"
+                 :on-change #(toggle! id)}]
+        [:label {:on-double-click #(reset! editing true)} text]
+        [:a.destroy {:on-click #(remove-todo! id)}]]
        (when @editing
          [todo-input {:text text
                       :on-save #(do (save! id %)


Replaced can-repair booleans with sets and added engineer

--- src/cljs/zetawar/data.cljs
+++ src/cljs/zetawar/data.cljs
@@ -136,7 +136,7 @@
                 :cost 75
                 :movement 9
                 :can-capture true
-                :can-repair false
+                :can-repair #{}
                 :min-range 1
                 :max-range 1
                 :armor-type :personnel
@@ -163,7 +163,7 @@
                  :cost 150
                  :movement 9
                  :can-capture true
-                 :can-repair false
+                 :can-repair #{}
                  :min-range 1
                  :max-range 2
                  :armor-type :personnel
@@ -190,7 +190,7 @@
               :cost 200
               :movement 9
               :can-capture true
-              :can-repair false
+              :can-repair #{}
               :min-range 2
               :max-range 3
               :armor-type :personnel
@@ -215,7 +215,7 @@
               :cost 200
               :movement 9
               :can-capture true
-              :can-repair false
+              :can-repair #{}
               :min-range 1
               :max-range 1
               :armor-type :personnel
@@ -243,7 +243,7 @@
              :cost 100
              :movement 9
              :can-capture true
-             :can-repair true
+             :can-repair #{:personnel}
              :min-range 1
              :max-range 1
              :armor-type :personnel
@@ -266,12 +266,39 @@
              :armored   2}
             :zoc
             [:personnel :armored]}
+    :engineer {:description "Engineer"
+               :cost 200
+               :movement 9
+               :can-capture true
+               :can-repair #{:armored}
+               :min-range 1
+               :max-range 1
+               :armor-type :personnel
+               :armor 6
+               :capturing-armor 4
+               :repair 1
+               :state-map :move-attack
+               :image "tilesets/elite-command/units/engineer-COLOR.png"
+               :terrain-effects
+               {:plains    {:movement-cost 3 :armor-bonus  0 :attack-bonus  0}
+                :mountains {:movement-cost 6 :armor-bonus  5 :attack-bonus  2}
+                :woods     {:movement-cost 4 :armor-bonus  3 :attack-bonus  2}
+                :desert    {:movement-cost 4 :armor-bonus -1 :attack-bonus -1}
+                :tundra    {:movement-cost 4 :armor-bonus -1 :attack-bonus -1}
+                :swamp     {:movement-cost 6 :armor-bonus -2 :attack-bonus -2}
+                :ford      {:movement-cost 5 :armor-bonus -1 :attack-bonus -1}
+                :base      {:movement-cost 2 :armor-bonus  3 :attack-bonus  2}}
+              :attack-strengths
+              {:personnel 5
+               :armored   2}
+              :zoc
+              [:personnel :armored]}
      ;; Armored
      :humvee {:description "Humvee"
               :cost 300
               :movement 15
               :can-capture false
-              :can-repair false
+              :can-repair #{}
               :min-range 1
               :max-range 1
               :armor-type :armored
@@ -296,7 +323,7 @@
             :cost 350
             :movement 12
             :can-capture false
-            :can-repair false
+            :can-repair #{}
             :min-range 1
             :max-range 1
             :armor-type :armored


Updated can-repair-other?

Updated can-repair-other?

--- src/cljs/zetawar/game.cljs
+++ src/cljs/zetawar/game.cljs
@@ -673,12 +673,7 @@
       false)))

 (defn can-repair-other? [db game unit]
-  true)
-  ;(try
-  ;  (check-can-repair-other db game unit)
-  ;  true
-  ;  (catch :default ex
-  ;    false)))
+  (get-in unit [:unit/type :unit-type/can-repair]))

 (defn can-be-repaired? [db game unit]
   (try
@@ -705,7 +700,7 @@
 (defn repair-other-tx
   ([db game repairer wounded]
    (let [new-state (check-can-repair-other db game repairer)]
-     ;(check-in-range db repairer wounded)
+     (check-in-range db repairer wounded)
      (let [wounded-count (:unit/count wounded)]
        [{:db/id (e wounded)
          :unit/count (min (:game/max-count-per-unit game)
@@ -724,16 +719,6 @@
         game (game-by-id db game-id)
         tx (repair-tx db game q r)]
     (d/transact! conn tx)))
-
-(defn repair-value
-  ([db game repairer wounded]
-    (min (:game/max-count-per-unit game)
-         (+ (:unit/count wounded)
-            (get-in repairer [:unit/type :unit-type/repair]))))
-  ([db game q1 r1 q2 r2]
-    (let [repairer (checked-unit-at db game q1 r1)
-          wounded  (checked-unit-at db game q2 r2)]
-      (repair-value db game repairer wounded))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Capture


make sure asterisks are escaped in usage strings (close #50)

--- src/cljs_api_gen/write.clj
+++ src/cljs_api_gen/write.clj
@@ -169,7 +169,7 @@
   [text]
   (let [[_ args] (re-find #"^\[(.*)\]$" text)]
     (if (not= "" (trim args))
-      args
+      (md-escape args)
       nil)))

 (defn source-link
@@ -214,9 +214,8 @@
                         (:removed item) md-strikethru)
         :data (with-out-str (pprint item))
         :history (map history-change-shield (:history item))
-        :signature (map #(hash-map :name (if (= "type" (:type item))
-                                           (str (:name item) ".")
-                                           (:name item))
+        :signature (map #(hash-map :name (cond-> (md-escape (:name item))
+                                           (= "type" (:type item)) (str "."))
                                    :args (sig-args %))
                         (:signature item))
         :clj-symbol (make-clj-ref item))


(Now »working« again from slime, with (use 'conexp.main) && then (conexp.main/gui))

--- src/conexp/gui/editors/contexts.clj
+++ src/conexp/gui/editors/contexts.clj
@@ -257,11 +257,11 @@
   [ctx]
   (deref (:context ctx)))

-(inherit-multimethod get-context conexp.fca.Context
+(inherit-multimethod get-context :conexp.fca.contexts/Context
   "Identity on fca-context.")

 (defmethod
-  get-context conexp.fca.Context
+  get-context :conexp.fca.contexts/Context
   [x] x)

 (defn make-context-compatible


WIP support for (:require [js.lib :refer [..]])

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -299,7 +299,12 @@
                          (update-in [:path] conj ns)
                          (update-in [:deps] conj ns))]
     (or (-> (env/deref-env) :namespaces ns)
-        (-> (env/deref-env) :js-dependency-index (get (name ns)))
+        (and (-> (env/deref-env) :js-dependency-index (get (name ns)))
+             (swap! env/*env* update-in [:namespaces ns :mappings] (fnil merge {})
+                    (reduce (fn [m k] (assoc m k {:op        :var
+                                                 :name      k
+                                                 :namespace ns}))
+                            {} refer)))
         (analyze-ns ns))))

 (defn core-macros []
@@ -317,8 +322,8 @@
                                   (if as
                                     (assoc m as ns)
                                     m)) {} require)
-        require-mappings (reduce (fn [m [ns {:keys [refer]}]]
-                                   (ensure-loaded ns env)
+        require-mappings (reduce (fn [m [ns {:keys [refer] :as spec}]]
+                                   (ensure-loaded spec env)
                                    ;; TODO: handle (:require [goog.lib :refer [things]]) ?
                                    (reduce #(assoc %1 %2 (get-in (env/deref-env)
                                                                  [:namespaces ns :mappings %2])) m refer))


Use the perc envelope for the bell.

Use the perc envelope for the bell.

--- src/klangmeister/instruments.cljs
+++ src/klangmeister/instruments.cljs
@@ -24,21 +24,16 @@
   (let [freq (music/equal-temperament midi)
         start (+ start (.-currentTime context))
         harmonic (fn [n proportion]
-                   (let [mid (+ start 0.01)
-                         gainNode (doto (.createGain context)
-                                    (.connect (.-destination context)))
-                         gain (doto (.-gain gainNode)
-                                (.setValueAtTime 0 start)
-                                (.linearRampToValueAtTime (* 0.05 proportion) mid)
-                                (.linearRampToValueAtTime 0 (+ mid proportion)))]
-                     (doto (.createOscillator context)
-                       (.connect gainNode)
-                       (-> .-frequency .-value (set! (* n freq)))
-                       (-> .-type  (set! "sine"))
-                       (.start start)
-                       (.stop (+ start 1.5)))))]
-    (doseq [h [1.0 2.0 3.0 4.1  5.2]
-            p [1.0 0.6 0.4 0.25 0.2]]
+                   (doto (.createOscillator context)
+                     (-> .-frequency .-value (set! (* n freq)))
+                     (-> .-type (set! "sine"))
+                     (.start start)
+                     (.stop (+ start 1.5))
+                     (connect (vol (* 0.05 proportion))
+                              (perc start 0.01 proportion)
+                              (.-destination context))))]
+    (doseq [h [1.0 2.0 3.0 4.1 5.2]
+            p [1.0 0.6 0.4 0.3 0.2]]
       (harmonic h p))))

 (defn fuzz! [midi start dur]


Fix bugs in k8s watch state integration test (#608)

* Read state directly from the first router for consistent results
* Handle composite scheduler /state/scheduler endpoint structure

--- waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
+++ waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
@@ -7,13 +7,19 @@
             [clojure.tools.logging :as log]
             [waiter.util.client-tools :refer :all]))

+(defn- get-watch-state [state-json]
+  (or (get-in state-json ["state" "watch-state"])
+      (get-in state-json ["state" "components" "kubernetes" "watch-state"])))
+
 (deftest ^:parallel ^:integration-fast test-kubernetes-watch-state-update
   (testing-using-waiter-url
     (when (using-k8s? waiter-url)
-      (let [{:keys [body] :as response} (make-request waiter-url "/state/scheduler" :method :get)
+      (let [cookies (all-cookies waiter-url)
+            router-url (-> waiter-url routers first val)
+            {:keys [body] :as response} (make-request router-url "/state/scheduler" :method :get :cookies cookies)
             _ (assert-response-status response 200)
             body-json (-> body str try-parse-json)
-            watch-state-json (get-in body-json ["state" "watch-state"])
+            watch-state-json (get-watch-state body-json)
             initial-pods-snapshot-version (get-in watch-state-json ["pods-metadata" "version" "snapshot"])
             initial-pods-watch-version (get-in watch-state-json ["pods-metadata" "version" "watch"])
             initial-rs-snapshot-version (get-in watch-state-json ["rs-metadata" "version" "snapshot"])
@@ -23,10 +29,10 @@
                                                    #(make-kitchen-request waiter-url % :path "/hello"))]
         (with-service-cleanup
           service-id
-          (let [{:keys [body] :as response} (make-request waiter-url "/state/scheduler" :method :get)
+          (let [{:keys [body] :as response} (make-request router-url "/state/scheduler" :method :get :cookies cookies)
                 _ (assert-response-status response 200)
                 body-json (-> body str try-parse-json)
-                watch-state-json (get-in body-json ["state" "watch-state"])
+                watch-state-json (get-watch-state body-json)
                 pods-snapshot-version' (get-in watch-state-json ["pods-metadata" "version" "snapshot"])
                 pods-watch-version' (get-in watch-state-json ["pods-metadata" "version" "watch"])
                 rs-snapshot-version' (get-in watch-state-json ["rs-metadata" "version" "snapshot"])


Use Google Closure to find dom element

Use Google Closure to find dom element

--- src/discuss/components/sidebar.cljs
+++ src/discuss/components/sidebar.cljs
@@ -2,6 +2,7 @@
   "Controlling the sidebar."
   (:require [om.core :as om]
             [om.dom :as dom]
+            [goog.dom :as gdom]
             [discuss.utils.common :as lib]
             [discuss.utils.views :as vlib]))

@@ -10,13 +11,13 @@
 (defn toggle
   "Toggle visibility of sidebar."
   ([]
-   (let [sidebar-dom (.getElementById js/document id)
-         main-wrapper (.getElementById js/document "main-wrapper")]
+   (let [sidebar-dom (gdom/getElement id)
+         main-wrapper (gdom/getElement "main-wrapper")]
      (lib/toggle-class sidebar-dom "active")
      (lib/toggle-class main-wrapper "active")))
   ([bool]
-   (let [sidebar-dom (.getElementById js/document id)
-         main-wrapper (.getElementById js/document "main-wrapper")]
+   (let [sidebar-dom (gdom/getElement id)
+         main-wrapper (gdom/getElement "main-wrapper")]
      (lib/toggle-class sidebar-dom "active" bool)
      (lib/toggle-class main-wrapper "active" bool))))


strip console codes for very large output

--- frontend/models/action.cljs
+++ frontend/models/action.cljs
@@ -1,5 +1,6 @@
 (ns frontend.models.action
-  (:require [frontend.datetime :as datetime]
+  (:require [clojure.string :as string]
+            [frontend.datetime :as datetime]
             [frontend.models.project :as proj]
             [frontend.utils :as utils :include-macros true]
             [goog.string :as gstring]
@@ -37,9 +38,16 @@
         starting-state (clj->js (get-in action [:converters-state type]))]
     (js/CI.terminal.ansiToHtmlConverter default-color "brblack" starting-state)))

+(defn maybe-strip-console-codes
+  "Strips console codes if output is over 2mb (assuming 2 bytes per char)"
+  [message]
+  (if (< (* 1024 1024) (count message))
+    (string/replace message #"\u001B\[[^A-Za-z]*[A-Za-z]" "")
+    message))
+
 (defn format-output [action output-index]
   (let [output (get-in action [:output output-index])
-        escaped-message (gstring/htmlEscape (:message output))
+        escaped-message (maybe-strip-console-codes (gstring/htmlEscape (:message output)))
         converter (new-converter action (keyword (:type output)))]
     (-> action
         (assoc-in [:output output-index :converted-message] (.append converter escaped-message))


Slight tweaks to Clojure runner - Only running tests for the testing namespace - No longer writing log files

--- frameworks/clojure/clojure/test/codewars.clj
+++ frameworks/clojure/clojure/test/codewars.clj
@@ -1,7 +1,7 @@
 (ns clojure.test.codewars
   (:refer-clojure :exclude [time])
   (:require
-   [clojure.test :refer :all :exclude [run-all-tests]]
+   [clojure.test :refer :all :exclude [run-tests]]
    [clojure.stacktrace :as stack]))

 (defmulti codewars-report :type)
@@ -59,7 +59,7 @@
                    " msecs"))
      ret#))

-(defmacro run-all-tests []
+(defmacro run-tests []
   (binding [clojure.test/report
             clojure.test.codewars/codewars-report]
-    (time (clojure.test/run-all-tests))))
+    (time (clojure.test/run-tests))))


codecs have to be public, since messaging uses them directly.

--- core/src/immutant/codecs.clj
+++ core/src/immutant/codecs.clj
@@ -47,7 +47,7 @@
      (decode [data#]
        (~decode data#))))

-(defonce ^:private ^Codecs codecs
+(defonce ^:internal ^Codecs codecs
   (-> (Codecs.)
     (.add None/INSTANCE)))


remove outdated filter

remove outdated filter

--- iwaswhere-web/src/clj/iwaswhere_web/graph.clj
+++ iwaswhere-web/src/clj/iwaswhere_web/graph.clj
@@ -35,8 +35,7 @@
           entry-comments-mentions (apply set/union (map :mentions (:comments entry)))
           mentions (set (map s/lower-case (set/union entry-mentions entry-comments-mentions)))

-          match? (or (set/subset? #{"#new-entry"} tags)
-                     (and (set/subset? q-tags tags)
+          match? (or (and (set/subset? q-tags tags)
                           (empty? (set/intersection q-not-tags tags))
                           (or (empty? q-mentions)
                               (seq (set/intersection q-mentions mentions)))


line parsing in try catch blocks

line parsing in try catch blocks

--- iwaswhere-web/src/clj/iwaswhere_web/store.clj
+++ iwaswhere-web/src/clj/iwaswhere_web/store.clj
@@ -26,13 +26,16 @@
       (with-open [reader (clojure.java.io/reader f)]
         (let [lines (line-seq reader)]
           (doseq [line lines]
-            (let [parsed (clojure.edn/read-string line)
-                  ts (:timestamp parsed)]
-              (if (:deleted parsed)
-                (do (swap! state ga/remove-node ts)
-                    (swap! entries-to-index dissoc ts))
-                (do (swap! entries-to-index assoc-in [ts] parsed)
-                    (swap! state ga/add-node ts parsed :startup))))))))))
+            (try
+              (let [parsed (clojure.edn/read-string line)
+                    ts (:timestamp parsed)]
+                (if (:deleted parsed)
+                  (do (swap! state ga/remove-node ts)
+                      (swap! entries-to-index dissoc ts))
+                  (do (swap! entries-to-index assoc-in [ts] parsed)
+                      (swap! state ga/add-node ts parsed :startup))))
+              (catch Exception ex
+                (log/error "Exception" ex "when parsing line:\n" line)))))))))

 (defn load-cfg
   "Load config from file, or default config."


remove redundant file

remove redundant file

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

--- plugins/SlideExplorer2/src/slide_explorer/cache.clj
+++ plugins/SlideExplorer2/src/slide_explorer/cache.clj
@@ -1,69 +0,0 @@
-(ns slide-explorer.cache
-  (:refer-clojure :exclude [get])
-  (:require [slide-explorer.image :as image])
-  (:import (java.util.concurrent Executors)
-           (java.io File)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Immutable LRU (Least Recently Used) cache
-;; based on, but different from, clojure.core.cache by @fogus
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defn empty-lru-map
-  "Factory method for producing a persistent map,
-   with metadata that allows LRU policy."
-  [limit]
-  (with-meta {}
-             {::lru {:limit limit
-                     :tick 0
-                     :priority {}}}))
-
-(defn remove-lru-excess
-  "Updates a LRU metadata map by removing the oldest item,
-   if there are too many items."
-  [lru-map]
-  (let [{:keys [priority tick limit]} (::lru (meta lru-map))]
-    (if (<= (count lru-map) limit)
-      lru-map
-      (let [old-key (apply min-key priority (keys priority))]
-        (vary-meta (dissoc lru-map old-key)
-                   update-in [::lru :priority] dissoc old-key)))))
-
-(defn update-lru-metadata
-  "Update a LRU metadata map to make key the most recent item."
-  [lru-meta key]
-  (let [tick (get-in lru-meta [::lru :tick])]
-    (if (not= tick (get-in lru-meta [::lru :priority key]))
-      (let [tick+ (inc tick)]
-        (-> lru-meta
-            (assoc-in [::lru :tick] tick+)
-            (update-in [::lru :priority] assoc key tick+)))
-      lru-meta)))
-
-(defn hit-item
-  "Updates lru-map's metadata so that key is the most recently used item."
-  [lru-map key]
-  (vary-meta lru-map update-lru-metadata key))
-
-(defn remove-item
-  "Remove an item from the LRU persistent map. Like dissoc."
-  [lru-map key]
-  (-> lru-map
-      (dissoc key val)
-      (vary-meta update-in [::lru :priority] dissoc key)))
-
-(defn add-item
-  "Add an item to the LRU persistent map. Like assoc."
-  ([lru-map key val overwrite?]
-    ;(println "add-item" lru-map key val)
-  (if (or overwrite?
-          (not (lru-map key)))
-    (-> lru-map
-        (assoc key val)
-        (hit-item key)
-        remove-lru-excess)
-    lru-map))
-  ([lru-map key val]
-    (add-item lru-map key val true)))
-


docstrings and merge, trim, mipmap

docstrings and merge, trim, mipmap

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

--- plugins/SlideExplorer2/src/slide_explorer/image.clj
+++ plugins/SlideExplorer2/src/slide_explorer/image.clj
@@ -16,34 +16,62 @@
 ; 6. Find stitching vector
 ; 7. Merge and scale the images

-; (defn getPixels [^BufferedImage image] (-> image .getRaster .getDataBuffer .getData))
+; ImageProcessor-related utilities

-(defn insert-image [proc-host proc-guest x-host y-host]
+(defn insert-image
+  "Insert one ImageProcessor into another."
+  [proc-host proc-guest x-host y-host]
   (when proc-guest
     (.insert proc-host proc-guest x-host y-host)))

-(defn crop [^ImageProcessor original x y w h]
+(defn make-stack
+  "Produces an ImageJ ImageStack from a collection
+   of ImageProcessors."
+  [processors]
+  (let [proc1 (first processors)
+        w (.getWidth proc1)
+        h (.getHeight proc1)
+        stack (ImageStack. w h)]
+    (doseq [processor processors]
+      (.addSlice stack processor))
+    stack))
+
+(defn processor-to-image
+  "Converts and ImageJ ImageProcessor to an AWT image."
+  [^ImageProcessor proc]
+  (.createImage proc))
+
+;; Trimming and displacing images
+
+(defn crop
+  "Crops an image, with upper-left corner at position x,y
+   and width and height w,h."
+  [^ImageProcessor original x y w h]
   (doto (.createProcessor original w h)
     (insert-image original (- x) (- y))))

-(defn raw-to-tile [raw-processor
-                    [overlap-x overlap-y]
-                    [desired-map-x desired-map-y]
-                    [found-map-x found-map-y]]
-  (let [dx (- found-map-x desired-map-x)
-        dy (- found-map-y desired-map-y)]
-    (crop proc
+(defn raw-to-tile
+  "Takes a raw ImageProcessor and trims edges by amount overlap,
+   offseting the trim to take into account the difference
+   between desired and found positions."
+  [raw-processor
+   [overlap-x overlap-y]
+   [desired-x desired-y]
+   [found-x found-y]]
+  (let [dx (- found-x desired-x)
+        dy (- found-y desired-y)]
+    (crop raw-processor
           (- (/ overlap-x 2) dx)
           (- (/ overlap-y 2) dy)
-          (- (.getWidth proc) overlap-x)
-          (- (.getHeight proc) overlap-y))))
+          (- (.getWidth raw-processor) overlap-x)
+          (- (.getHeight raw-processor) overlap-y))))

-(defn processor-to-image [^ImageProcessor proc]
-  (.createImage proc))
+;; Merge and scale the images for Mipmap

-;; Merge and scale the images
-
-(defn merge-and-scale [img1 img2 img3 img4]
+(defn merge-and-scale
+  "Takes four ImageProcessors (tiles) and tiles them in a
+   2x2 mosaic with no gaps, then scales pixels to half size."
+  [img1 img2 img3 img4]
   (let [w (.getWidth img1)
         h (.getHeight img1)
         large (.createProcessor img1 (* 2 w) (* 2 h))]
@@ -57,26 +85,18 @@

 ;; Channels/LUTs

-(defn lut-object [^Color color ^double min max gamma]
+(defn lut-object
+  "Creates an ImageJ LUT object with given parameters."
+  [^Color color ^double min ^double max ^double gamma]
   (let [lut (ImageUtils/makeLUT color gamma)]
     (set! (. lut min) min)
     (set! (. lut max) max)
     lut))

-(def black-lut (lut-object Color/BLACK 0 255 1.0))
+(def black-lut
+  "An LUT such that the image is not displayed."
+  (lut-object Color/BLACK 0 255 1.0))

-(defn make-stack
-  "Produces an ImageJ ImageStack from a collection
-   of ImageProcessors."
-  [processors]
-  (let [proc1 (first processors)
-        w (.getWidth proc1)
-        h (.getHeight proc1)
-        stack (ImageStack. w h)]
-    (doseq [processor processors]
-      (.addSlice stack processor))
-    stack))
-
 (defn overlay
   "Takes n ImageProcessors and n lut objects and produces a BufferedImage
    containing the overlay."
@@ -97,9 +117,11 @@
         (.setLuts (into-array luts))))))

-;; test
+;; testing

-(defn show [img-or-proc]
+(defn show
+  "Shows an AWT or ImageProcessor in an ImageJ window."
+  [img-or-proc]
   (.show (ImagePlus. "" img-or-proc))
   img-or-proc)


fixing back button issue

fixing back button issue

--- src/clj/ku_expo/handler.clj
+++ src/clj/ku_expo/handler.clj
@@ -112,6 +112,12 @@
   (POST "/register" [& params] (auth/register-user params))
   (friend/logout (ANY "/logout" request (redirect "/"))))

+(defn wrap-headers
+  [handler]
+  (fn [request]
+    (let [response (handler request)]
+      (assoc-in response [:headers "Cache-Control"] "no-cache, no-store, must-revalidate"))))
+
 (def app
   (-> (handler/site
         (friend/authenticate app-routes
@@ -119,7 +125,8 @@
                               :default-landing-uri "/"
                               :credential-fn #(creds/bcrypt-credential-fn db/get-user %)
                               :workflows [(workflows/interactive-form
-                                          :login-failure-handler (fn [req] (auth/wrong-login)))]}))
+                                            :login-failure-handler (fn [req] (auth/wrong-login)))]}))
+      (wrap-headers)
       (cors/wrap-cors identity))) ; TODO improve security here i.e. limit to site URL

 (defn -main [& args]


allow lambda define shorthand

allow lambda define shorthand

--- src/clj/wombat/compiler.clj
+++ src/clj/wombat/compiler.clj
@@ -192,6 +192,17 @@
       (seq->list (map (partial sanitize-quasiquote env) form)))
     form))

+(defn sanitize-define
+  [env [define name & val :as form]]
+  (debug "sanitize-define: " form)
+  (if-not (symbol? name)
+    (let [[name & params] (expand-params name)]
+      (when (or (nil? name)
+                (special-token? name))
+        (throw (IllegalArgumentException. "Invalid lambda define: " form)))
+      (recur env (list define name (list* 'lambda params val))))
+    (list* define name (map (partial sanitize (assoc env name name)) val))))
+
 (defn sanitize-seq
   [env form]
   (if (seq form)
@@ -204,8 +215,7 @@

       #{'letrec} :>> (partial sanitize-letrec env)

-      #{'define 'define-macro} :>> (fn [[define name & val]]
-                                     (list* define name (map (partial sanitize (assoc env name name)) val)))
+      #{'define 'define-macro} :>> (partial sanitize-define env)

       #{'define-class*} form


add function to get all movements as a map of movement names -> map of data

--- src/cljs/movement/data.cljs
+++ src/cljs/movement/data.cljs
@@ -53,6 +53,9 @@
                      :leg-lift
                      :headstand
                      :air-baby])
+
+(defn get-movements-map []
+  (into {} (map (fn [m] [(:name m) m]) all-movements)))

 (def all-movements [{:name "Beinsving sideveis",
                      :image "side-leg-swing.png",
@@ -1629,4 +1632,4 @@
                           {:set 1N, :movement "Flies med strikk over hodet", :slot-category #{:shoulder-mobility}, :rep 10N}
                           {:set 1N, :movement "Flies med strikk", :slot-category #{:shoulder-mobility}, :rep 10N}
                           {:set 1N, :movement "Lave flies med strikk", :slot-category #{:shoulder-mobility}, :rep 10N}]]}]
-  )+  )


Minor code clean up

Minor code clean up

--- src/cljs/om_sente/core.cljs
+++ src/cljs/om_sente/core.cljs
@@ -15,12 +15,14 @@

 (def app-state (atom {:text "Hello world!"}))

-(defn send-field [e text]
+(defn send-field [e owner state]
   (when (== (.-keyCode e) 13)
-    (chsk-send! [:test/echo text])))
+    (chsk-send! [:test/echo (:text state)])
+    (set! (.-value (om/get-node owner "data")) "")))

-(defn field-change [e owner text]
-  (om/set-state! owner :text (.. e -target -value)))
+(defn field-change [e owner state]
+  (let [value (.. e -target -value)]
+    (om/set-state! owner :text value)))

 (defn field-view [app owner]
   (reify


Separate side effects from functional code

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -12,7 +12,6 @@
 (enable-console-print!)
 (set! *assert* false) ;; Set to true for the debug mode

-;; TODO - Try to plug the history of brower for "back"
 ;; TODO - Try to bring some domain vocabulary here: it gets too complicated to trace
 ;; TODO - http://www.w3schools.com/howto/howto_js_sidenav.asp
 ;; TODO - http://www.w3schools.com/svg/svg_grad_radial.asp
@@ -337,23 +336,20 @@
         move (ai-algo @game @current-player)]
     (update-game! play-move move)))

-(defn cancel-last-move! []
-  (swap! app-state update-in [:games]
-    (fn [old-list]
-      (let [ai-turn? #(contains? (:ai-players %) (:player %))
-            new-list (drop-while ai-turn? (drop 1 old-list))]
-        (if (empty? new-list)
-          (take-last 1 old-list)
-          new-list)))
-    ))
+(defn cancel-last-move
+  [old-turns]
+  (let [ai-turn? #(contains? (:ai-players %) (:player %))
+        new-turns (drop-while ai-turn? (drop 1 old-turns))]
+    (if (empty? new-turns)
+      (take-last 1 old-turns)
+      new-turns)))

 (defn- handle-game-event!
   [msg]
   (case msg
     :new-game (swap! app-state assoc-in [:games] (list (new-game)))
     :restart (swap! app-state update-in [:games] #(take-last 1 %))
-    :undo (cancel-last-move!)
-    ))
+    :undo (swap! app-state update-in [:games] cancel-last-move)))

 (defn start-game-loop
   "Manage transitions between player moves, ai moves, and generic game events"


Updating the game now add to list of games

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -310,19 +310,22 @@
         :red init-block-count
         :green init-block-count}})))

-(defonce app-state (atom (new-game)))
-(def game (reagent/cursor app-state []))
-(def board (reagent/cursor game [:board]))
-(def scores (reagent/cursor game [:scores]))
-(def current-player (reagent/cursor game [:player]))
-(def ai-players (reagent/cursor game [:ai-players]))
+(defonce app-state
+  (atom {:games (list (new-game))
+         :help false}))
+
+(def game (reaction (first (get-in @app-state [:games]))))
+(def board (reaction (get-in @game [:board])))
+(def scores (reaction (get-in @game [:scores])))
+(def current-player (reaction (get-in @game [:player])))
+(def ai-players (reaction (get-in @game [:ai-players])))
 (def end-of-game (reaction (nil? @current-player)))

 (defn update-game! [f & args]
-  (swap! app-state #(apply f % args)))
+  (swap! app-state update-in [:games] conj (apply f @game args)))

 (defn new-game! []
-  (reset! app-state (new-game)))
+  (swap! app-state assoc-in [:games] (list (new-game))))

 (defn is-ai? [player]
   (contains? @ai-players player))
@@ -378,7 +381,7 @@

 (defn ^boolean show-help?
   [game x y]
-  (and (:help game) (get-move-at game (:player game) [x y])))
+  (and (:help @app-state) (get-move-at game (:player game) [x y])))

 (defn empty-cell
   [x y game]


Fix typo

Fix typo

--- src/clojush/meta_errors.clj
+++ src/clojush/meta_errors.clj
@@ -198,7 +198,7 @@
       (if (< (count hist) 2)
         0
         (if (some (fn [[new-err old-err]]
-                    (< new-err older-err))
+                    (< new-err old-err))
                   (map vector (first hist) (second hist)))
           0
           1)))))


Part 2: Get rid of {0, 1} -> {2, 3} mapping for added/added0. Fixes #28.

Now that we copying from tx_lookup_before -> tx_lookup_after, we don't
need to avoid duplicating rows.

--- src/common/datomish/db.cljc
+++ src/common/datomish/db.cljc
@@ -183,7 +183,7 @@
           (apply str
                  "INSERT INTO temp.tx_lookup_after (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag,
                   rid, e, a, v, tx, value_type_tag)
-                  SELECT e, a, v, ?, 0 + 2, value_type_tag, v, value_type_tag,
+                  SELECT e, a, v, ?, 0, value_type_tag, v, value_type_tag,
                   rowid, e, a, v, ?, value_type_tag
                   FROM datoms
                   WHERE "
@@ -211,7 +211,7 @@
           (apply str
                  "INSERT INTO temp.tx_lookup_after (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag,
                   rid, e, a, v, tx, value_type_tag)
-                  SELECT e, a, v, ?, 0 + 2, value_type_tag, v, value_type_tag,
+                  SELECT e, a, v, ?, 0, value_type_tag, v, value_type_tag,
                   rowid, e, a, v, ?, value_type_tag
                   FROM datoms
                   WHERE "
@@ -429,7 +429,7 @@
         ;; Second is slower, but still only one table walk: lookup old value by ea.
         insert-into-tx-lookup
         ["INSERT INTO temp.tx_lookup_after
-          SELECT t.e0, t.a0, t.v0, t.tx0, t.added0 + 2, t.value_type_tag0, t.index_avet0, t.index_vaet0, t.index_fulltext0, t.unique_value0, t.sv, t.svalue_type_tag, d.rowid, d.e, d.a, d.v, d.tx, d.value_type_tag
+          SELECT t.e0, t.a0, t.v0, t.tx0, t.added0, t.value_type_tag0, t.index_avet0, t.index_vaet0, t.index_fulltext0, t.unique_value0, t.sv, t.svalue_type_tag, d.rowid, d.e, d.a, d.v, d.tx, d.value_type_tag
           FROM temp.tx_lookup_before AS t
           LEFT JOIN datoms AS d
           ON t.e0 = d.e AND
@@ -439,7 +439,7 @@
              t.sv IS NOT NULL

           UNION ALL
-          SELECT t.e0, t.a0, t.v0, t.tx0, t.added0 + 2, t.value_type_tag0, t.index_avet0, t.index_vaet0, t.index_fulltext0, t.unique_value0, t.sv, t.svalue_type_tag, d.rowid, d.e, d.a, d.v, d.tx, d.value_type_tag
+          SELECT t.e0, t.a0, t.v0, t.tx0, t.added0, t.value_type_tag0, t.index_avet0, t.index_vaet0, t.index_fulltext0, t.unique_value0, t.sv, t.svalue_type_tag, d.rowid, d.e, d.a, d.v, d.tx, d.value_type_tag
           FROM temp.tx_lookup_before AS t,
                datoms AS d
           WHERE t.sv IS NULL AND
@@ -450,13 +450,13 @@
         ["INSERT INTO transactions (e, a, v, tx, added, value_type_tag)
           SELECT e0, a0, v0, ?, 1, value_type_tag0
           FROM temp.tx_lookup_after
-          WHERE added0 IS 3 AND e IS NULL" tx] ;; TODO: get rid of magic value 3. XXX
+          WHERE added0 IS 1 AND e IS NULL" tx]

         t-retract-datoms-carefully
         ["INSERT INTO transactions (e, a, v, tx, added, value_type_tag)
           SELECT e, a, v, ?, 0, value_type_tag
           FROM temp.tx_lookup_after
-          WHERE added0 IS 2 AND ((sv IS NOT NULL) OR (sv IS NULL AND v0 IS NOT v)) AND v IS NOT NULL" tx] ;; TODO: get rid of magic value 2. XXX
+          WHERE added0 IS 0 AND ((sv IS NOT NULL) OR (sv IS NULL AND v0 IS NOT v)) AND v IS NOT NULL" tx]
         ]
     (go-pair
       (doseq [q [build-indices insert-into-tx-lookup
@@ -470,12 +470,12 @@
           SELECT e0, a0, v0, ?, value_type_tag0,
           index_avet0, index_vaet0, index_fulltext0, unique_value0
           FROM temp.tx_lookup_after
-          WHERE added0 IS 3 AND e IS NULL" tx] ;; TODO: get rid of magic value 3. XXX
+          WHERE added0 IS 1 AND e IS NULL" tx]

         ;; TODO: retract fulltext datoms correctly.
         d-retract-datoms-carefully
-        ["WITH ids AS (SELECT l.rid FROM temp.tx_lookup_after AS l WHERE l.added0 IS 2 AND ((l.sv IS NOT NULL) OR (l.sv IS NULL AND l.v0 IS NOT l.v)))
-         DELETE FROM datoms WHERE rowid IN ids" ;; TODO: get rid of magic value 2. XXX
+        ["WITH ids AS (SELECT l.rid FROM temp.tx_lookup_after AS l WHERE l.added0 IS 0 AND ((l.sv IS NOT NULL) OR (l.sv IS NULL AND l.v0 IS NOT l.v)))
+         DELETE FROM datoms WHERE rowid IN ids"
          ]]
     (-run-queries conn [d-datoms-not-already-present d-retract-datoms-carefully]
                   "Transaction violates unique constraint")))


make it possible to toggle :variable-renaming and :property-renaming

:variable-renaming can mess with npm graphql. not changing the
default for now since it only seems to affect graphql for now
and the impact of disabling can be quite substantial

--- src/main/shadow/build/closure.clj
+++ src/main/shadow/build/closure.clj
@@ -22,7 +22,7 @@
                                          CommandLineRunner VariableMap SourceMapInput DiagnosticGroups
                                          CheckLevel JSModule CompilerOptions$LanguageMode
                                          SourceMap$LocationMapping BasicErrorManager Result ShadowAccess
-                                         SourceMap$DetailLevel SourceMap$Format ClosureCodingConvention CompilationLevel AnonymousFunctionNamingPolicy DiagnosticGroup NodeTraversal StrictModeCheck)
+                                         SourceMap$DetailLevel SourceMap$Format ClosureCodingConvention CompilationLevel AnonymousFunctionNamingPolicy DiagnosticGroup NodeTraversal StrictModeCheck VariableRenamingPolicy PropertyRenamingPolicy)
            (shadow.build.closure ReplaceCLJSConstants NodeEnvInlinePass ReplaceRequirePass PropertyCollector)
            (com.google.javascript.jscomp.deps ModuleLoader$ResolutionMode ModuleNames)
            (com.google.javascript.jscomp.parsing.parser FeatureSet)
@@ -139,9 +139,6 @@
   (when (contains? opts :closure-extra-annotations)
     (. closure-opts (setExtraAnnotationNames (map name (:closure-extra-annotations opts)))))

-  (when (contains? opts :closure-module-roots)
-    (. closure-opts (setModuleRoots (:closure-module-roots opts))))
-
   (when (contains? opts :closure-generate-exports)
     (. closure-opts (setGenerateExports (:closure-generate-exports opts))))

@@ -149,6 +146,26 @@
     (. closure-opts (setRewritePolyfills (:rewrite-polyfills opts))))

   (. closure-opts (setOutputCharset (Charset/forName (:closure-output-charset opts "UTF-8"))))
+
+  (when (contains? opts :variable-renaming)
+    (.setVariableRenaming
+      closure-opts
+      (case (:variable-renaming opts)
+        false VariableRenamingPolicy/OFF
+        :off VariableRenamingPolicy/OFF
+        :local VariableRenamingPolicy/LOCAL
+        :all VariableRenamingPolicy/ALL
+        (throw (ex-info "invalid :variable-renaming (use :off, :local or :all)" {})))))
+
+  (when (contains? opts :property-renaming)
+    (.setPropertyRenaming
+      closure-opts
+      (case (:property-renaming opts)
+        false PropertyRenamingPolicy/OFF
+        :off PropertyRenamingPolicy/OFF
+        true PropertyRenamingPolicy/ALL_UNQUOTED
+        :all-unquoted PropertyRenamingPolicy/ALL_UNQUOTED
+        (throw (ex-info "invalid :property-renaming (use :off or :all-unquoted)" {})))))

   closure-opts)


shorten message and open add-channel unless they already have hooks

--- src-cljs/frontend/components/integrations.cljs
+++ src-cljs/frontend/components/integrations.cljs
@@ -196,32 +196,29 @@
                                      (om/get-shared owner :listener-key)))
     om/IRender
     (render [_]
-      (let [{:keys [cast! team-db]} (om/get-shared owner)]
+      (let [{:keys [cast! team-db]} (om/get-shared owner)
+            hooks (->> (d/datoms @team-db :aevt :slack-hook/channel-name)
+                    (map :e)
+                    (map #(d/entity @team-db %))
+                    (sort-by :db/id))]
         (html
          [:div.slack-channels
           [:a.vein.make {:role "button"
-                         :on-click (if (om/get-state owner :show-form?)
-                                     #(do
-                                        (om/set-state! owner :show-form? false)
-                                        (om/set-state! owner :show-info? false))
-                                     #(om/set-state! owner :show-form? true))}
+                         :on-click #(om/update-state! owner (fn [s] (update-in s [:show-form?] not)))}
            (common/icon :plus)
            [:span "Add a Channel"]]
-          (when (om/get-state owner :show-form?)
+          (when (get (om/get-state owner) :show-form? (empty? hooks))
             (list
-              [:div.content.make
-               [:p "Visit "
-                [:a {:href "https://slack.com/services/new"
-                     :target "_blank"
-                     :role "button"}
-                 "Slack's integrations page"]
-                ", then scroll to the bottom and add a new incoming webhook. "
-                "Choose a channel, copy its webhook url, and then use it to fill out the following form: "]]
-              (om/build slack-form app)))
-          (for [slack-hook (->> (d/datoms @team-db :aevt :slack-hook/channel-name)
-                                (map :e)
-                                (map #(d/entity @team-db %))
-                                (sort-by :db/id))]
+             [:div.content.make
+              [:p "Go to "
+               [:a {:href "https://slack.com/services/new"
+                    :target "_blank"
+                    :role "button"}
+                "Slack's integrations page"]
+               ", then scroll to the end and add a new incoming webhook. "
+               "Choose a channel, create the hook, then copy the webhook url."]]
+             (om/build slack-form app)))
+          (for [slack-hook hooks]
             (om/build post-to-slack-button {:doc-id (:document/id app)
                                             :team-uuid (get-in app [:team :team/uuid])
                                             :slack-hook slack-hook}


Some cleanup

Some cleanup

--- src/dashportal/handler.clj
+++ src/dashportal/handler.clj
@@ -3,33 +3,29 @@
             [compojure.route :as route]
             [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
             [ring.util.response :as response]
-            [environ.core :as env])
-  (:use [hiccup.core] ring.adapter.jetty)
-  )
-
-(defn generate-head [refresh-time-seconds]
-  [:head
-   [:meta {:charset "UTF-8"}]
-   [:meta {:http-equiv "refresh" :content refresh-time-seconds}]
-   [:style {:type "text/css"}
-    "
-    body, html
-    {
-      margin: 0; padding: 0; height: 100%; overflow: hidden;
-    }
-    #content
-    {
-      position:absolute; left: 0; right: 0; bottom: 0; top: 0px;
-    }"
-    ]
-   ]
-  )
+            [environ.core :as env]
+            [hiccup.core :refer :all]
+            [ring.adapter.jetty :refer :all]))

 (defn generate-page [url refresh-seconds]
   (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n"
        (html
          [:html
-          (generate-head refresh-seconds)
+          [:head
+           [:meta {:charset "UTF-8"}]
+           [:meta {:http-equiv "refresh" :content refresh-seconds}]
+           [:style {:type "text/css"}
+            "
+            body, html
+            {
+              margin: 0; padding: 0; height: 100%; overflow: hidden;
+            }
+            #content
+            {
+              position:absolute; left: 0; right: 0; bottom: 0; top: 0px;
+            }"
+            ]
+           ]
           [:body
            [:iframe {:src url :width "100%" :height "100%" :frameborder 0}
             "Your browser does not support iframes."


Align syntax

Align syntax

--- src/runbld/publish/email.clj
+++ src/runbld/publish/email.clj
@@ -8,43 +8,43 @@

 (def Ctx
   {
-   (s/required-key :commit) s/Str
-   (s/required-key :commit-desc) s/Str
-   (s/required-key :commit-email) s/Str
-   (s/required-key :commit-msg) s/Str
-   (s/required-key :commit-name) s/Str
-   (s/required-key :commit-time)  s/Str
-   (s/required-key :env) {s/Str s/Any}
-   (s/required-key :github-name) s/Str
-   (s/required-key :id) s/Str
-   (s/required-key :job-name) s/Str
-   (s/required-key :mail-from) s/Str
-   (s/required-key :org) s/Str
-   (s/required-key :project) s/Str
-   (s/required-key :rcpt-to) (s/cond-pre s/Str [s/Str])
-   (s/required-key :scriptfile) s/Str
-   (s/required-key :start-millis) s/Num
-   (s/required-key :time-end) s/Str
-   (s/required-key :time-start) s/Str
+   (s/required-key :commit           ) s/Str
+   (s/required-key :commit-desc      ) s/Str
+   (s/required-key :commit-email     ) s/Str
+   (s/required-key :commit-msg       ) s/Str
+   (s/required-key :commit-name      ) s/Str
+   (s/required-key :commit-time      ) s/Str
+   (s/required-key :env              ) {s/Str s/Any}
+   (s/required-key :github-name      ) s/Str
+   (s/required-key :id               ) s/Str
+   (s/required-key :job-name         ) s/Str
+   (s/required-key :mail-from        ) s/Str
+   (s/required-key :org              ) s/Str
+   (s/required-key :project          ) s/Str
+   (s/required-key :rcpt-to          ) (s/cond-pre s/Str [s/Str])
+   (s/required-key :scriptfile       ) s/Str
+   (s/required-key :start-millis     ) s/Num
+   (s/required-key :time-end         ) s/Str
+   (s/required-key :time-start       ) s/Str

-   (s/optional-key :args) [s/Str]
-   (s/optional-key :branch) s/Str
-   (s/optional-key :cmd) [s/Str]
-   (s/optional-key :cmd-source) s/Str
-   (s/optional-key :cwd) s/Str
-   (s/optional-key :end-millis) s/Num
-   (s/optional-key :github-page) s/Str
-   (s/optional-key :jenkins-executor) (s/maybe s/Str)
-   (s/optional-key :jenkins-labels) (s/maybe s/Str)
-   (s/optional-key :jenkins-node) (s/maybe s/Str)
-   (s/optional-key :jenkins-number) (s/maybe s/Str)
-   (s/optional-key :job-name-extra) s/Str
-   (s/optional-key :profile-name) s/Str
-   (s/optional-key :program) s/Str
-   (s/optional-key :status) s/Num
-   (s/optional-key :took) s/Num
-   (s/optional-key :url) (s/maybe s/Str)
-   (s/optional-key :workspace) s/Str
+   (s/optional-key :args             ) [s/Str]
+   (s/optional-key :branch           ) s/Str
+   (s/optional-key :cmd              ) [s/Str]
+   (s/optional-key :cmd-source       ) s/Str
+   (s/optional-key :cwd              ) s/Str
+   (s/optional-key :end-millis       ) s/Num
+   (s/optional-key :github-page      ) s/Str
+   (s/optional-key :jenkins-executor ) (s/maybe s/Str)
+   (s/optional-key :jenkins-labels   ) (s/maybe s/Str)
+   (s/optional-key :jenkins-node     ) (s/maybe s/Str)
+   (s/optional-key :jenkins-number   ) (s/maybe s/Str)
+   (s/optional-key :job-name-extra   ) s/Str
+   (s/optional-key :profile-name     ) s/Str
+   (s/optional-key :program          ) s/Str
+   (s/optional-key :status           ) s/Num
+   (s/optional-key :took             ) s/Num
+   (s/optional-key :url              ) (s/maybe s/Str)
+   (s/optional-key :workspace        ) s/Str
    })

 (defn maybe-split-addr [s]


Extending types via protocols doesn't allow for comments. Consider a refactor

--- src/net_ns/server/atom_mapper.clj
+++ src/net_ns/server/atom_mapper.clj
@@ -2,20 +2,11 @@
   (:require [net-ns.server.mapper :as mapper])
   (:use [clojure.contrib.core :only (dissoc-in)]))

+(declare register-client)
+
 (extend-type clojure.lang.Atom
   mapper/Mapper
     (register-client
-      "Register a client as an endpoint, and optionally take
-      and initial set of functions.  If init-set is not a
-      clojure.lang.PersistentHashSet, it is ignored.
-      Arguments:
-        client-map - an atom of a map
-        host - a string, the hostname of the client
-        [init-set] - a set of of strings, the names of functions
-      Returns:
-        the map with the client added
-      NOTE:
-        THIS WILL MODIFY THE CLIENT-MAP"
       ([client-map host]
        (swap! client-map assoc host #{}))
       ([client-map host init-set]
@@ -24,30 +15,17 @@
          (register-client client-map host))))

     (register-fn
-      "Register a function with a client.  If the client is not
-      already in the serve-map, it is added with the function as
-      its init-set.
-      Arguments:
-        client-map - a map, anything that supports APersistentMap
-        f - a string, the name of the function to register
-        host - a string, the hostname of the client
-      Returns:
-        the map with the updated function list for the client
-      NOTE:
-        THIS WILL MODIFY THE CLIENT-MAP"
       [client-map f host]
-      (let [func-set (serve-map host)]
+      (let [func-set (client-map host)]
         (if (nil? func-set)
           (register-client client-map host #{f})
           (swap! client-map assoc host (conj (@client-map host) f)))))

     (unregister-client
-      ""
       [client-map host]
       (swap! client-map dissoc host))

     (unregister-fn
-      ""
       [client-map f host]
       (swap! client-map dissoc-in [host f])))


Revert function

Revert function

--- src-cljs/frontend/components/builds_table.cljs
+++ src-cljs/frontend/components/builds_table.cljs
@@ -15,7 +15,7 @@
   (:require-macros [frontend.utils :refer [html]]))

 (defn dashboard-icon [name]
-  [:i.material-icons "settings"])
+  [:img.dashboard-icon {:src (utils/cdn-path (str "/img/inner/icons/" name ".svg"))}])

 (defn build-status-badge-wording [build]
   (let [wording       (build-model/status-words build)


fix my brainfart, boolean is not a function to be called!

--- src/hivewing_core/worker_config.clj
+++ src/hivewing_core/worker_config.clj
@@ -60,8 +60,8 @@
   Returns true if it worked"
   [worker-uuid parameters & args]
   ; Want to split the parameters
-  (let [clean-parameters (filter #(worker-config-valid-name? (key %1)) parameters)
-        suppress-change-publication (:suppress-change-publication (apply hash-map args))]
+  (let [clean-parameters (select-keys parameters (filter #(worker-config-valid-name? %1) (keys parameters)))
+        suppress-change-publication (:suppress-change-publication (apply hash-map args)) ]
     (doseq [kv-pair clean-parameters]
       (let [upload-data {"uuid" (str worker-uuid)
                          "key"  (name (get kv-pair 0)),
@@ -69,6 +69,5 @@
                          "data" (str (get kv-pair 1))
                  }]
         (put-item aws-credentials ddb-worker-table upload-data)))
-      (if (suppress-change-publication)
-        :do-nothing
+      (if (not suppress-change-publication)
         (pubsub/publish-change "worker-config" worker-uuid clean-parameters))))


Print port

Print port

--- src/servisne_info/webapp.clj
+++ src/servisne_info/webapp.clj
@@ -15,6 +15,7 @@

 (defn -main [& [port]]
   (let [port (Integer. (or port (env :port) 5000))]
+    (println "PORT: " port)
     (reset! server (run-server handler/app {:port port}))
     (.addShutdownHook (Runtime/getRuntime) (Thread. stop-server))
     (handler/init)))


WIP more stuff

WIP more stuff

--- src/puppetlabs/jdbc-util/core.clj
+++ src/puppetlabs/jdbc-util/core.clj
@@ -1,6 +1,9 @@
 (ns puppetlabs.jdbc-util
+  (:import java.util.regex.Pattern)
   (:require [clojure.java.jdbc           :as jdbc]
-            [puppetlabs.kitchensink.core :as ks])
+            [clojure.string              :as str]
+            [puppetlabs.kitchensink.core :as ks]))
+
 (defn- convert-result-arrays
   "Converts Java and JDBC arrays in a result set using the provided function
    (eg. vec, set). Values which aren't arrays are unchanged."
@@ -22,3 +25,69 @@
                    (convert-result-arrays vec
                                           (jdbc/result-set-seq rs))))]
     (jdbc/db-query-with-resultset db sql-and-params convert)))
+
+(defn ordered-group-by
+  [f coll]
+  (let [grouped-w-index (loop [i 0, groups (transient {}), coll (seq coll)]
+                          (if-let [x (first coll)]
+                            (let [k (f x)
+                                  group (get groups k [i])
+                                  groups' (assoc! groups k (conj group x))]
+                              (recur (inc i) groups' (next coll)))
+                            ;; else (nothing left in coll)
+                            (persistent! groups)))]
+    (->> (seq grouped-w-index)
+      ; sort the groups by the index where the first member appeared
+      (sort-by #(get-in % [1 0])))))
+
+(defn aggregate-submap-by
+  "Given a sequence of maps in results where each map contains agg-key and
+agg-val as keys, groups the maps that are identical except for the values in
+agg-key or agg-val. The values of agg-key and agg-val are turned into a map
+and stored in the resulting map under under-key."
+  [agg-key agg-val under-key results]
+  (for [[combined [_ & all]] (ordered-group-by #(dissoc % agg-key agg-val) results)]
+    (assoc combined under-key (->> all
+                               (map (juxt agg-key agg-val))
+                               (remove (comp nil? first))
+                               (into {})))))
+
+(defn aggregate-column
+  "Given a sequence of rows as maps, aggregate the values of `column` into
+a sequence under `under`, combining rows that are equal except for the value
+of `column`. Useful for consolidating the results of an outer join."
+  [column under results]
+  (for [[combined [_ & all]] (ordered-group-by #(dissoc % column) results)]
+    (assoc combined under (map #(get % column) all))))
+
+(defn- sequence-placeholder
+  [xs]
+  (str "("
+       (->> (repeat (count xs) "?")
+         (str/join ","))
+       ")"))
+
+(defn- replace-nth-?
+  [^String s n replacement]
+  (let [through-?-pattern (Pattern/compile (format "([^?]+?\\?){%d}" (inc n)))]
+    (if-let [[match] (re-find through-?-pattern s)]
+      (let [tail (.substring s (.length ^String match) (.length s))
+            replaced (str/replace match #"(.*)\?$" (str "$1" replacement))]
+        (str replaced tail))
+      (throw (IllegalArgumentException. (str "there are not " n " '?'s in the given string"))))))
+
+(defn expand-seq-params
+  "A helper for prepared SQL statements with sequential parameters. Returns
+a new prepared statement with every `?` that corresponded to a sequential
+parameter expanded to a tuple literal of the appropriate length and flattened
+parameters."
+  [[sql & parameters]]
+  (let [seq-params-w-indices (->> (map vector parameters (range))
+                               (filter (comp sequential? first)))
+        [sql'] (reduce (fn [[sql shift] [param i]]
+                         (let [shift' (+ shift (dec (count param)))
+                               expansion (sequence-placeholder param)]
+                           [(replace-nth-? sql (+ i shift) expansion) shift']))
+                       [sql 0]
+                       seq-params-w-indices)]
+    (vec (conj (flatten parameters) sql'))))


keep track of the converter's state in the action

--- frontend/models/action.cljs
+++ frontend/models/action.cljs
@@ -21,14 +21,23 @@
                                                       (js/Date.parse start_time)))
         :else nil))

-(defn format-output [action]
-  (let [out-converter (js/CI.terminal.ansiToHtmlConverter "brblue")
-        err-converter (js/CI.terminal.ansiToHtmlConverter "red")]
-    (str (reduce (fn [acc output]
-                   (let [converter (if (= "err" (:type output))
-                                     err-converter
-                                     out-converter)]
-                     (str acc (.append converter (gstring/htmlEscape (:message output))))))
-                 "" (:output action))
-         (.get_trailing out-converter)
-         (.get_trailing err-converter))))
+(defn new-converter [action type]
+  (let [default-color (if (= :err :type) "red" "brblue")
+        starting-state (clj->js (get-in action [:converters-state type]))]
+    (js/CI.terminal.ansiToHtmlConverter default-color starting-state)))
+
+(defn format-output [action output-index]
+  (let [output (get-in action [:output output-index])
+        converter (new-converter action (keyword (:type output)))]
+    (-> action
+        (assoc-in [:output output-index :converted-message] (.append converter (:message output)))
+        (assoc-in [:converters-state (keyword (:type output))] (js->clj (.currentState converter) :keywordize-keys true)))))
+
+(defn format-latest-output [action]
+  (if-let [output (seq (:output action))]
+    (format-output action (dec (count output)))
+    action))
+
+(defn trailing-output [action]
+  (str (get-in action [:converters-state :out :trailing_out])
+       (get-in action [:converters-state :err :trailing_out])))


Update plot x-ranges on current time and use a simpler design for fetching plot data.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -26,14 +26,12 @@

 (defonce query-window (reagent/atom "1d"))

-(defn periodic-event-channel [ interval-ms ]
-  (let [channel (chan)
-        put-now #(put! channel {:msg-type :timestamp :t (time/now)})]
-    (put-now)
-    (js/setInterval put-now interval-ms)
-    channel))
-
-(defonce time-event-channel (periodic-event-channel 15000))
+(defn time-atom [ interval-ms ]
+  (let [ new-atom (reagent/atom (time/now)) ]
+    (js/setInterval #(reset! new-atom (time/now)) interval-ms)
+    new-atom))
+
+(defonce current-time (time-atom 5000))

 (defn range-ending-at [ end-t window-seconds ]
   (let [begin-t (time/minus end-t (time/seconds window-seconds))]
@@ -41,20 +39,7 @@
      :begin-t (time-coerce/to-long begin-t)
      :end-t (time-coerce/to-long end-t)}))

-(defn query-range-channel-2 [ time-event-channel ]
-  (let [ output (chan)
-        output-pub (pub output :msg-type)]
-    (go-loop [ time (time/now) qws @query-window ]
-      (>! output (range-ending-at time (parse-query-window qws)))
-      (when-let [ msg (<! time-event-channel)]
-        (case (:msg-type msg)
-          :timestamp (recur (:t msg) qws)
-          :query-window (recur time (:window-spec msg)))))
-    output-pub))
-
-(defonce update-pub (query-range-channel-2 time-event-channel))
-
-(defonce dashboard-state (reagent/atom {:series [] :text ""}))
+(defonce dashboard-state (reagent/atom {:series [] }))

 (defonce window-width (reagent/atom nil))

@@ -79,6 +64,7 @@
   (ajax-get "/series-names" then))

 (defn fetch-series-data [ series-name query-range then ]
+  (.error js/console "Query: " series-name (pr-str query-range))
   (let [ request-t (time/now) ]
     (ajax-get (str "/data/" series-name) query-range
               #(then (merge {:series-data %
@@ -86,26 +72,6 @@
                              :request-t request-t
                              :response-t (time/now)}
                             query-range)))))
-
-(defn range-ending-at-current-window [ end-t ]
-  (range-ending-at end-t (parse-query-window @query-window)))
-
-(defn series-data-channel [ series-name query-range-channel ]
-  (let [channel (chan)]
-    (go-loop []
-      (when-let [ query-range  (<! query-range-channel)]
-        (fetch-series-data series-name query-range #(put! channel %))
-        (recur)))
-    channel))
-
-(defn subscribe-plot-data [ series series-state ]
-  (let [update-out-chan (chan)
-        channel (series-data-channel series update-out-chan) ]
-    (sub update-pub :range update-out-chan)
-    (go-loop []
-      (when-let [ data (<! channel) ]
-        (swap! series-state assoc :series-data data)
-        (recur)))))

 (defn series-tsplot-view [ series series-data series-range ]
   (let [dom-node (reagent/atom nil)]
@@ -134,20 +100,40 @@
                     {:width (.-clientWidth node)
                      :height (.-clientHeight node)})]])})))

+(defn range-ending-at-current-window [ end-t ]
+  (range-ending-at end-t (parse-query-window @query-window)))
+
+(defn subscribe-plot-data [ series-name series-state-atom ]
+  (let [control-channel (chan)]
+    (go-loop [ last-query-range nil ]
+      (when-let [ query-range (<! control-channel) ]
+        (when (not (= query-range last-query-range))
+          (swap! series-state-atom assoc :series-data
+                 (<! (<<< fetch-series-data series-name query-range))))
+        (recur query-range)))
+    control-channel))
+
 (defn series-tsplot [ series-name ]
   (let [dom-node (reagent/atom nil)
-        series-state (reagent/atom {})]
+        series-state (reagent/atom {})
+        series-data-loop (reagent/atom nil)]
     (reagent/create-class
      {:display-name (str "series-tsplot-" series-name)

       :component-did-mount
       (fn [ this ]
-        (subscribe-plot-data series-name series-state))
+        (reset! series-data-loop (subscribe-plot-data series-name series-state))
+        (put! @series-data-loop (range-ending-at-current-window @current-time)))
+
+      :component-will-update
+      (fn [ this new-argv ]
+        (when @series-data-loop
+          (put! @series-data-loop (range-ending-at-current-window @current-time))))

       :reagent-render
       (fn [ & rest ]
         [series-tsplot-view series-name (:series-data @series-state)
-         (range-ending-at-current-window (time/now))])})))
+         (range-ending-at-current-window @current-time)])})))

 (defn- remove-series [ series-name ]
   (swap! dashboard-state merge
@@ -175,7 +161,6 @@

 (defn end-edit [ text state ]
   (when (parse-query-window text)
-    (put! time-event-channel {:msg-type :query-window :window-spec text})
     (reset! query-window text)))

 (defn input-field [ initial-text text-valid? on-enter ]


refactored test. improved readability

refactored test. improved readability

--- test-cljs/complico/test/prices.cljs
+++ test-cljs/complico/test/prices.cljs
@@ -22,14 +22,11 @@
 (deftest find-prices-case-pounds-and-pence
   (is (= (last (first (prices/find-prices "£300.00"))) "300.00")))

-(deftest convert-price-should-use-real-conversion-for-non-zero-real-prices
-  (is (= (prices/convert-price "£" "1" prices/conversion-functions) "£2.00 / £2.00")))
-
 (deftest convert-price-should-select-from-conversion-function-list-using-price-value-as-list-index-with-modulus
-  (def mock-conversion-funcs [(fn [_ _] "0") (fn [_ _] "1") (fn [_ _] "2")])
-  (is (= (prices/convert-price "£" "1" mock-conversion-funcs) "1"))
-  (is (= (prices/convert-price "£" "2" mock-conversion-funcs) "2"))
-  (is (= (prices/convert-price "£" "3" mock-conversion-funcs) "0")))
+  (def mock-price-conversion-funcs [(fn [_ _] "0") (fn [_ _] "1") (fn [_ _] "2")])
+  (is (= (prices/convert-price "£" "1.99" mock-price-conversion-funcs) "1"))
+  (is (= (prices/convert-price "£" "2.99" mock-price-conversion-funcs) "2"))
+  (is (= (prices/convert-price "£" "3.99" mock-price-conversion-funcs) "0")))

 (deftest correctly-finds-multiple-elems
   (let [root-elem (node


Racism is bad, yo: Two threads "could" miss with same "key" at same "time"

--- modules/cache/src/main/clojure/immutant/cache.clj
+++ modules/cache/src/main/clojure/immutant/cache.clj
@@ -127,11 +127,14 @@
   ;; We assume value is a delay, which we can't serialize and don't
   ;; want to force yet
   (miss [this key value]
-    (swap! delayed assoc (vec key) (delay (cc/miss cache (vec key) @value) @value))
+    (swap! delayed
+           (fn [m k v] (if (contains? m k) m (assoc m k v)))
+           (vec key)
+           (delay (cc/miss cache (vec key) @value) @value))
     this)
   (lookup [_ key]
     (when-let [value (get @delayed (vec key))]
-      (deref value)
+      (force value)
       (swap! delayed dissoc (vec key)))
     ;; Callers expect to deref the returned value
     (reify


Switching to clojure 1.6.0

Switching to clojure 1.6.0

--- resources/leiningen/new/mesos_framework/project.clj
+++ resources/leiningen/new/mesos_framework/project.clj
@@ -3,7 +3,7 @@
   :url "https://github.com/clj-mesos-workshop/hello-mesos"
   :license {:name "MIT"
             :url "https://github.com/edpaget/hello-mesos/LICENSE"}
-  :dependencies [[org.clojure/clojure "1.7.0"]
+  :dependencies [[org.clojure/clojure "1.6.0"]
                  [edpaget/clj-mesos "0.22.1-SNAPSHOT"]
                  [curator "0.0.6"]
                  [com.stuartsierra/component "0.2.3"]]


optimize fn*

optimize fn*

--- src/main/clojure/cljs/analyzer.cljc
+++ src/main/clojure/cljs/analyzer.cljc
@@ -1169,71 +1169,101 @@

 (declare analyze-wrap-meta)

+(defn fn-name-var [env locals name]
+  (when-not (nil? name)
+    (let [ns       (-> env :ns :name)
+          shadow   (get locals name)
+          shadow   (when (nil? shadow)
+                     (get-in env [:js-globals name]))
+          fn-scope (:fn-scope env)
+          name-var {:name name
+                    :info {:fn-self-name true
+                           :fn-scope fn-scope
+                           :ns ns
+                           :shadow shadow}}
+          tag      (-> name meta :tag)
+          ret-tag  (when-not (nil? tag)
+                     {:ret-tag tag})]
+      (merge name-var ret-tag))))
+
+(defn analyze-fn-methods-pass2* [menv locals type meths]
+  (doall (map #(analyze-fn-method menv locals % type) meths)))
+
+(defn analyze-fn-methods-pass2 [menv locals type meths]
+  (no-warn (analyze-fn-methods-pass2* menv locals type meths)))
+
 (defmethod parse 'fn*
   [op env [_ & args :as form] name _]
-  (analyze-wrap-meta
-   (let [[name meths] (if (symbol? (first args))
-                        [(first args) (next args)]
-                        [name (seq args)])
-         ;;turn (fn [] ...) into (fn ([]...))
-         meths (if (vector? (first meths)) (list meths) meths)
-         locals (:locals env)
-         name-var (if name
-                    (merge
-                      {:name name
-                       :info {:fn-self-name true
-                              :fn-scope (:fn-scope env)
-                              :ns (-> env :ns :name)
-                              :shadow (or (locals name)
-                                          (get-in env [:js-globals name]))}}
-                     (when-let [tag (-> name meta :tag)]
-                       {:ret-tag tag})))
-         env (if name
-               (update-in env [:fn-scope] conj name-var)
-               env)
-         locals (if (and locals name) (assoc locals name name-var) locals)
-         type (-> form meta ::type)
-         protocol-impl (-> form meta ::protocol-impl)
-         protocol-inline (-> form meta ::protocol-inline)
-         menv (if (> (count meths) 1) (assoc env :context :expr) env)
-         menv (merge menv
-                     {:protocol-impl protocol-impl
-                      :protocol-inline protocol-inline})
-         methods (map #(analyze-fn-method menv locals % type) meths)
-         max-fixed-arity (apply max (map :max-fixed-arity methods))
-         variadic (boolean (some :variadic methods))
-         locals (if name
-                  (update-in locals [name] assoc
-                             ;; TODO: can we simplify? - David
-                             :fn-var true
-                             :variadic variadic
-                             :max-fixed-arity max-fixed-arity
-                             :method-params (map :params methods))
-                  locals)
-         methods (if name
-                   ;; a second pass with knowledge of our function-ness/arity
-                   ;; lets us optimize self calls
-                   (no-warn (doall (map #(analyze-fn-method menv locals % type) meths)))
-                   methods)
-         form (vary-meta form dissoc ::protocol-impl ::protocol-inline ::type)]
-     (let [variadic-methods (filter :variadic methods)
-           variadic-params (count (:params (first variadic-methods)))
-           param-counts (map (comp count :params) methods)]
-       (when (< 1 (count variadic-methods))
-         (warning :multiple-variadic-overloads env {:name name-var}))
-       (when (not (or (zero? variadic-params) (= variadic-params (+ 1 max-fixed-arity))))
-         (warning :variadic-max-arity env {:name name-var}))
-       (when (not= (distinct param-counts) param-counts)
-         (warning :overload-arity env {:name name-var})))
-     {:env env
-      :op :fn :form form :name name-var :methods methods :variadic variadic
-      :tag 'function
-      :recur-frames *recur-frames* :loop-lets *loop-lets*
-      :jsdoc [(when variadic "@param {...*} var_args")]
-      :max-fixed-arity max-fixed-arity
-      :protocol-impl protocol-impl
-      :protocol-inline protocol-inline
-      :children (mapv :expr methods)})))
+  (let [[name meths] (if (symbol? (first args))
+                       [(first args) (next args)]
+                       [name (seq args)])
+        ;; turn (fn [] ...) into (fn ([]...))
+        meths        (if (vector? (first meths))
+                       (list meths)
+                       meths)
+        locals       (:locals env)
+        name-var     (fn-name-var env locals name)
+        env          (if-not (nil? name)
+                       (update-in env [:fn-scope] conj name-var)
+                       env)
+        locals       (if (and (not (nil? locals))
+                              (not (nil? name)))
+                       (assoc locals name name-var)
+                       locals)
+        form-meta    (meta form)
+        type         (::type form-meta)
+        proto-impl   (::protocol-impl form-meta)
+        proto-inline (::protocol-inline form-meta)
+        menv         (if (> (count meths) 1)
+                       (assoc env :context :expr)
+                       env)
+        menv         (merge menv
+                       {:protocol-impl proto-impl
+                        :protocol-inline proto-inline})
+        methods      (map #(analyze-fn-method menv locals % type) meths)
+        mfa          (apply max (map :max-fixed-arity methods))
+        variadic     (boolean (some :variadic methods))
+        locals       (if-not (nil? name)
+                       (update-in locals [name] assoc
+                         ;; TODO: can we simplify? - David
+                         :fn-var true
+                         :variadic variadic
+                         :max-fixed-arity mfa
+                         :method-params (map :params methods))
+                       locals)
+        methods      (if-not (nil? name)
+                       ;; a second pass with knowledge of our function-ness/arity
+                       ;; lets us optimize self calls
+                       (analyze-fn-methods-pass2 menv locals type meths)
+                       methods)
+        form         (vary-meta form dissoc ::protocol-impl ::protocol-inline ::type)
+        js-doc       (when (true? variadic)
+                       "@param {...*} var_args")
+        children     (mapv :expr methods)
+        ast          {:op :fn
+                      :env env
+                      :form form
+                      :name name-var
+                      :methods methods
+                      :variadic variadic
+                      :tag 'function
+                      :recur-frames *recur-frames*
+                      :loop-lets *loop-lets*
+                      :jsdoc [js-doc]
+                      :max-fixed-arity mfa
+                      :protocol-impl proto-impl
+                      :protocol-inline proto-inline
+                      :children children}]
+    (let [variadic-methods (filter :variadic methods)
+          variadic-params  (count (:params (first variadic-methods)))
+          param-counts     (map (comp count :params) methods)]
+      (when (< 1 (count variadic-methods))
+        (warning :multiple-variadic-overloads env {:name name-var}))
+      (when (not (or (zero? variadic-params) (== variadic-params (+ 1 mfa))))
+        (warning :variadic-max-arity env {:name name-var}))
+      (when (not= (distinct param-counts) param-counts)
+        (warning :overload-arity env {:name name-var})))
+    (analyze-wrap-meta ast)))

 (defmethod parse 'letfn*
   [op env [_ bindings & exprs :as form] name _]


Organize routes

Organize routes

--- src/silly_image_store/handler.clj
+++ src/silly_image_store/handler.clj
@@ -3,8 +3,7 @@
             [environ.core :refer [env]]
             [compojure.core :refer :all]
             [compojure.handler :as handler]
-            [compojure.route :as route])
-  (:use [ring.util.response :only (file-response resource-response status)]))
+            [compojure.route :as route]))

 (def images-dir
   (env :base-store-dir))
@@ -16,8 +15,7 @@
       {:status 404})))

 (defroutes app-routes
-  (GET "/image/:image-name" [image-name]
-    (serve-image image-name))
+  (GET "/image/:image-name" [image-name] (serve-image image-name))
   (route/resources "/")
   (route/not-found "Not Found"))


Story ID: RPC-297 added control positioning

--- src/untangled/support_viewer.cljs
+++ src/untangled/support_viewer.cljs
@@ -10,11 +10,12 @@

 (defui ^:once SupportViewerRoot
   static om/IQuery
-  (query [this] [:react-key :current-position :client-time :frames])
+  (query [this] [:react-key :current-position :client-time :frames :position])
   Object
   (render [this]
-    (let [{:keys [react-key current-position client-time frames] :or {react-key "ROOT"}} (om/props this)]
-      (dom/div #js {:key react-key :className "history-controls"}
+    (let [{:keys [react-key current-position client-time frames position] :or {react-key "ROOT"}} (om/props this)]
+      (dom/div #js {:key react-key :className (str "history-controls " (name position))}
+        (dom/button #js {:onClick #(om/transact! this '[(support-viewer/toggle-position)])} (tr "<===>"))
         (dom/button #js {:onClick #(om/transact! this '[(support-viewer/step-back)])} (tr "<Back"))
         (dom/button #js {:onClick #(om/transact! this '[(support-viewer/step-forward)])} (tr "Forward>"))
         (dom/hr nil)
@@ -56,6 +57,7 @@
                                     :support     (atom (core/new-untangled-client
                                                          :initial-state {:history          history
                                                                          :application      app
+                                                                         :position        :controls-left
                                                                          :client-time      (js/Date.)
                                                                          :frames           (inc max-idx)
                                                                          :current-position max-idx}
@@ -78,3 +80,11 @@

 (defmethod m/mutate 'support-viewer/step-back [{:keys [state]} k params] {:action #(history-step state dec)})

+(defmethod m/mutate 'support-viewer/toggle-position [{:keys [state]} k params]
+  {:action (fn []
+             (let [{:keys [position]} @state
+                   new-position (cond
+                                  (= :controls-left position) :controls-right
+                                  :else :controls-left)]
+               (swap! state assoc :position new-position)))})
+