omit unnecessary param count check for vector and map params

--- src/asphalt/param.clj
+++ src/asphalt/param.clj
@@ -58,25 +58,19 @@
                   (count param-types) (count param-keys)) {:param-types param-types
                                                            :param-keys  param-keys}))
   (let [prepared-stmt-sym (with-meta (gensym "prepared-stmt-") {:tag "java.sql.PreparedStatement"})
-        params-sym   (gensym "sql-params-")
-        mparam-count (count (distinct param-keys))
-        vparam-count (count param-keys)
-        indices-sym  (gensym "param-indices-")
-        indices-exp  (iparam/params-indices param-keys param-types params-sym)]
+        params-sym  (gensym "sql-params-")
+        indices-sym (gensym "param-indices-")
+        indices-exp (iparam/params-indices param-keys param-types params-sym)]
     `(let [~params-sym ~params
            ~@(when-not (vector? indices-exp)  ; indices-exp is a vector for single params, S-expr otherwise
                [indices-sym indices-exp])]
        (let [~prepared-stmt-sym ~prepared-stmt]
          ~(if (= param-keys (vec (range (count param-keys))))  ; is it vector params?
-            `(if (<= ~vparam-count (count ~params-sym))
-               (when (< (count ~params-sym) ~(count param-keys)) ; short circuit for vector params
-                 (i/expected (str ~(count param-keys) " or more params") ~params-sym))
-               (i/expected ~(str vparam-count " params") ~params-sym))
-            `(if (<= ~mparam-count (count ~params-sym))
-               (doseq [each-key# ~param-keys]
-                 (when-not (contains? ~params-sym each-key#)
-                   (i/expected (str "key " each-key# " to be present in SQL params") ~params-sym)))
-               (i/expected ~(str mparam-count " params") ~params-sym)))
+            `(when (< (count ~params-sym) ~(count param-keys)) ; short circuit for vector params
+               (i/expected (str ~(count param-keys) " or more params") ~params-sym))
+            `(doseq [each-key# ~param-keys]
+               (when-not (contains? ~params-sym each-key#)
+                 (i/expected (str "key " each-key# " to be present in SQL params") ~params-sym))))
          ~@(->> (map vector param-types param-keys)
              (map-indexed (fn [^long idx [t k]]
                             (iparam/lay-param-expr prepared-stmt-sym t


Fix typos

Fix typos

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -369,7 +369,7 @@
   (reset [this]
          (assert (> (alength marked-nodes) 0))
          (assert (> (alength marked-ixes) 0))
-         (set! node (.pop nodes))
+         (set! node (.pop marked-nodes))
          (set! ix (.pop marked-ixes))))

 (defn iterator [tree]
@@ -422,7 +422,7 @@
          (.reset iterator)))

 (defn trieterator [iterator]
-  (Trieterator. iterator (least-key (.-key-len iterator)) nil -1 0 (.-end? it) (.-key-len iterator)))
+  (Trieterator. iterator (least-key (.-key-len iterator)) nil -1 0 (.-end? iterator) (.-key-len iterator)))

 ;; works on trees
 (deftype Intersection [iterators ^:mutable end? key-len]
@@ -458,7 +458,7 @@
   (assert (every? #(= (.-key-len (aget iterators 0)) (.-key-len %)) iterators))
   (if (> (alength iterators) 1)
     (if (some #(.-end? %) iterators)
-      (Intersection. iterators true)
+      (Intersection. iterators true (.-key-len (aget iterators 0)))
       (let [intersection (Intersection. (into-array (sort-by #(.key %) key-compare iterators)) false (.-key-len (aget iterators 0)))]
         (.search intersection 0)
         intersection))
@@ -476,11 +476,11 @@
   (maintain [this]
             (set! end? (.-end? (aget key-ix->intersection key-ix))))
   (next [this]
-        (when (false? end)
+        (when (false? end?)
           (.next (aget key-ix->intersection key-ix))
           (.maintain this)))
   (seek [this key]
-        (when (false? end)
+        (when (false? end?)
           (.seek (aget key-ix->intersection key-ix) key)
           (.maintain this)))
   (down [this]
@@ -570,7 +570,7 @@
         (assert false "TODO")))

 (defn treeterator [iterator]
-  (let [treeterator (Treeterator. iterator (least-key (.-key-len iterator)) 0 (.-key-len iterator))]
+  (let [treeterator (Treeterator. iterator (least-key (.-key-len iterator)) 0 (.-end? iterator) (.-key-len iterator))]
     (.walk-down treeterator)
     treeterator))


re-enable enrich; enrich fixed in last commit

--- src/babel/engine.cljc
+++ src/babel/engine.cljc
@@ -42,7 +42,7 @@
         (log/error (str "grammar is empty."))
         (exception (str "grammar is empty.")))))

-  (let [do-enrich false ;(if do-enrich do-enrich true)
+  (let [do-enrich (if do-enrich do-enrich true)
         spec (if (or (= false add-subcat)
                      (fail? (unify spec {:synsem {:subcat '()}}))
                      (not (= :none (get-in spec [:synsem :subcat] :none))))


exclude alias macro in cljs, we need to redef

--- src/main/clojure/cljs/core.cljc
+++ src/main/clojure/cljs/core.cljc
@@ -34,7 +34,8 @@

                             cond-> cond->> as-> some-> some->>

-                            if-some when-some test ns-interns ns-unmap var vswap! macroexpand-1 macroexpand])
+                            if-some when-some test ns-interns ns-unmap var vswap! macroexpand-1 macroexpand
+                            #?(:cljs alias)])
   (:require clojure.walk
             clojure.set
             cljs.compiler


Fix a bug: row/col fields were not being coerced to ints.

The rework of the app state and parser functions broke the way
updates to maze state were being coerced to integers if they represented
row or column dimensions.  I don't know what was wrong, because I realized
that there was an entirely different way to handle that, and I like this
way better.

--- src/snergly/core.cljs
+++ src/snergly/core.cljs
@@ -49,21 +49,6 @@
 ;; -----------------------------------------------------------------------------
 ;; Parsing

-(defmulti coerce-param (fn [p v] p))
-
-(run! #(derive % ::integer)
-      [::rows ::columns ::cell-size ::start-row ::start-col ::end-row ::end-col])
-
-(defmethod coerce-param :default
-  [_ val]
-  val)
-
-(defmethod coerce-param ::integer
-  [_ val]
-  (js/parseInt val))
-
-
-
 (defmulti read om/dispatch)

 (defmethod read :default
@@ -79,7 +64,7 @@
 (defmethod mutate 'snergly.core/set-maze-param
   [{:keys [state]} _ {:keys [param value]}]
   {:value {:keys {:maze {:params [param]}}}
-   :action #(swap! state assoc-in [:maze :params param] (coerce-param param value))})
+   :action #(swap! state assoc-in [:maze :params param] value)})

 (defmethod mutate 'snergly.core/set-status
   [{:keys [state]} _ {:keys [status]}]
@@ -145,9 +130,15 @@
                   analysis start-row start-col end-row end-col]} params
           {:keys [active grid]} animation
           modify (fn [maze-param e]
-                   ;; Note that the symbol doesn't need to be explicitly namespace-qualified here, but if I used
-                   ;; xact!, it would be.
+                   ;; Note that the symbol doesn't need to be explicitly namespace-qualified here,
+                   ;; but using xact! below, it has to be.
                    (om.next/transact! this `[(set-maze-param {:param ~maze-param :value ~(aget e "target" "value")})]))
+          modify-int (fn [maze-param e]
+                       (let [val (aget e "target" "value")]
+                         (if (re-matches #"^\d+$" val)
+                           (xact! this (snergly.core/set-maze-param
+                                         {:param maze-param
+                                          :value (js/parseInt val)})))))
           go-async (fn [maze e]
                      (protocols/start-animation (get-in maze [:animation :animator]) (:params maze) ui))
           ]
@@ -177,7 +168,7 @@
                                      :min      2
                                      :max      99
                                      :style    #js {:width "30px"}
-                                     :onInput  (partial modify :rows)}))
+                                     :onInput  (partial modify-int :rows)}))
           (dom/label nil
                      "Columns: "
                      (dom/input #js {:type     "number"
@@ -186,7 +177,7 @@
                                      :min      2
                                      :max      99
                                      :style    #js {:width "30px"}
-                                     :onInput  (partial modify :columns)})))
+                                     :onInput  (partial modify-int :columns)})))
         (dom/div
           nil
           (dom/label nil
@@ -206,7 +197,7 @@
                                        :min      0
                                        :max      (dec rows)
                                        :style    #js {:width "30px"}
-                                       :onInput  (partial modify :start-row)}))
+                                       :onInput  (partial modify-int :start-row)}))
             (dom/label nil
                        "Start Column: "
                        (dom/input #js {:type     "number"
@@ -215,7 +206,7 @@
                                        :min      0
                                        :max      (dec columns)
                                        :style    #js {:width "30px"}
-                                       :onInput  (partial modify :start-col)}))))
+                                       :onInput  (partial modify-int :start-col)}))))
         (when (= "path" analysis)
           (dom/div
             nil
@@ -227,7 +218,7 @@
                                        :min      0
                                        :max      (dec rows)
                                        :style    #js {:width "30px"}
-                                       :onInput  (partial modify :end-row)}))
+                                       :onInput  (partial modify-int :end-row)}))
             (dom/label nil
                        "End Column: "
                        (dom/input #js {:type     "number"
@@ -236,7 +227,7 @@
                                        :min      0
                                        :max      (dec columns)
                                        :style    #js {:width "30px"}
-                                       :onInput  (partial modify :end-col)}))))
+                                       :onInput  (partial modify-int :end-col)}))))
         (dom/div
           nil
           (dom/button #js {:id       "gobutton"


Better readability

Better readability

--- src/main/resources/builtins.clj
+++ src/main/resources/builtins.clj
@@ -59,9 +59,11 @@
   (if (empty? lst)
     '()
     (let [pivot (first lst)
-          lower (filter (fn [n] (comp n pivot))
+          lower (filter (fn [n]
+                          (comp n pivot))
                         (rest lst))
-          not-lower (filter (fn [n] (not (comp n pivot)))
+          not-lower (filter (fn [n]
+                              (not (comp n pivot)))
                             (rest lst))]
       (concat (sort comp lower)
               (list pivot)


Remove duplicate implementation from ICondition protocol.

--- src/suricatta/dsl.clj
+++ src/suricatta/dsl.clj
@@ -123,10 +123,7 @@
   java.lang.String
   (condition* [s] (DSL/condition s))

-  org.jooq.impl.CombinedCondition
-  (condition* [c] c)
-
-  org.jooq.impl.SQLCondition
+  org.jooq.Condition
   (condition* [c] c)

   clojure.lang.PersistentList


CMR-1297 Cleans up some collection search format tests

--- system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
@@ -41,6 +41,13 @@
     (d/ingest "PROV1" (dc/collection {:short-name "S1"
                                       :version-id "V1"
                                       :entry-title "ET1"}))))
+
+(defn- get-concept-by-id-helper
+  [concept options]
+  (:body
+   (search/get-concept-by-concept-id
+    (:concept-id concept)
+    options)))

 ;; Tests that we can ingest and find items in different formats
 (deftest multi-format-search-test
@@ -176,43 +183,45 @@
           (search/find-metadata :collection :dif10 {} {:url-extension "dif10"}))))

     (testing "Get by concept id in formats"
-      (testing "supported formats"
+      (testing "umm->xml formats"
         (are [concept mime-type format-key url-extension]
-             (let [response (search/get-concept-by-concept-id
-                              (:concept-id concept)
-                              {:url-extension url-extension :accept mime-type})]
-               (= (umm/umm->xml concept format-key) (:body response)))
-             c1-echo "application/dif+xml" :dif nil
-             c1-echo nil :dif "dif"
-             c1-echo "application/echo10+xml" :echo10 nil
-             c1-echo nil :echo10 "echo10"
-             c3-dif "application/dif+xml" :dif nil
-             c3-dif nil :dif "dif"
-             c5-iso "application/iso19115+xml" :iso19115 nil
-             c5-iso nil :iso19115 "iso19115"
-             c5-iso nil :iso19115 "iso"
-             c7-smap "application/iso:smap+xml" :iso-smap nil
-             c7-smap nil :iso-smap "iso_smap"
-             c8-dif10 "application/dif10+xml" :dif10 nil
-             c8-dif10 nil :dif10 "dif10"))
-
-      (testing "atom/json formats"
-        (let [get-response (fn [concept format]
-                             (search/get-concept-by-concept-id
-                              (:concept-id concept)
-                              {:url-extension (name format)}))]
-          (are [concept] (= (da/collection->expected-atom concept)
-                            (dj/parse-json-collection (:body (get-response concept :json))))
-            c1-echo
-            c3-dif
-            c5-iso)
-          (are [concept] (= [(da/collection->expected-atom concept)]
-                            (:entries
-                             (da/parse-atom-result :collection
-                                                   (:body (get-response concept :atom)))))
-            c1-echo
-            c3-dif
-            c5-iso)))
+          (= (umm/umm->xml concept format-key)
+             (get-concept-by-id-helper concept {:url-extension url-extension :accept mime-type}))
+          c1-echo "application/dif+xml" :dif nil
+          c1-echo nil :dif "dif"
+          c1-echo "application/echo10+xml" :echo10 nil
+          c1-echo nil :echo10 "echo10"
+          c3-dif "application/dif+xml" :dif nil
+          c3-dif nil :dif "dif"
+          c5-iso "application/iso19115+xml" :iso19115 nil
+          c5-iso nil :iso19115 "iso19115"
+          c5-iso nil :iso19115 "iso"
+          c7-smap "application/iso:smap+xml" :iso-smap nil
+          c7-smap nil :iso-smap "iso_smap"
+          c8-dif10 "application/dif10+xml" :dif10 nil
+          c8-dif10 nil :dif10 "dif10"))
+
+      (testing "json"
+        (are [concept options]
+          (= (da/collection->expected-atom concept)
+             (dj/parse-json-collection (get-concept-by-id-helper concept options)))
+          c1-echo {:url-extension "json"}
+          c1-echo {:accept        "application/json"}
+          c3-dif  {:url-extension "json"}
+          c3-dif  {:accept        "application/json"}
+          c5-iso  {:url-extension "json"}
+          c5-iso  {:accept        "application/json"}))
+
+      (testing "atom"
+        (are [concept options]
+          (= [(da/collection->expected-atom concept)]
+             (:entries (da/parse-atom-result :collection (get-concept-by-id-helper concept options))))
+          c1-echo {:url-extension "atom"}
+          c1-echo {:accept        "application/atom+xml"}
+          c3-dif  {:url-extension "atom"}
+          c3-dif  {:accept        "application/atom+xml"}
+          c5-iso  {:url-extension "atom"}
+          c5-iso  {:accept        "application/atom+xml"}))

       (testing "native format direct retrieval"
         ;; Native format can be specified using application/xml, application/metadata+xml,


intial docstrings

intial docstrings

--- src/transit/core.cljs
+++ src/transit/core.cljs
@@ -27,6 +27,10 @@
   (finalize [_ v] (persistent! v)))

 (defn reader
+  "Return a transit reader. type may be either :json or :json-verbose.
+   opts may be a map optionally containing a :decoders entry. The value
+   of :decoders should be map from tag to a decoder function which returns
+   then in-memory representation of the semantic transit value."
   ([type] (reader type nil))
   ([type opts]
      (t/reader (name type)
@@ -87,6 +91,10 @@
   (stringRep [_ v] nil))

 (defn writer
+  "Return a transit writer. type maybe either :json or :json-verbose.
+   opts is a map containing a :handlers entry. :handlers is a JavaScript
+   array of interleaved type constructors and handler instances for those
+   type constructors."
   ([type] (writer type nil))
   ([type opts]
      (let [keyword-handler (KeywordHandler.)


Factor out nonce

Factor out nonce

--- src/icecap/crypto.clj
+++ src/icecap/crypto.clj
@@ -145,8 +145,9 @@
   Please note that this uses a fixed nonce, and that's *perfectly
   fine*. This is the only message ever encrypted with that key!"
   []
-  (reify EncryptionScheme
-    (encrypt [_ key plaintext]
-      (secretbox/encrypt key (secretbox/int->nonce 1) plaintext))
-    (decrypt [_ key ciphertext]
-      (secretbox/decrypt key (secretbox/int->nonce 1) ciphertext))))
+  (let [nonce (secretbox/int->nonce 1)]
+    (reify EncryptionScheme
+      (encrypt [_ key plaintext]
+        (secretbox/encrypt key nonce plaintext))
+      (decrypt [_ key ciphertext]
+        (secretbox/decrypt key nonce ciphertext)))))


DM+CM #77 - delete redundant api handler

--- src/objective8/handlers/api.clj
+++ src/objective8/handlers/api.clj
@@ -95,17 +95,6 @@
       (log/info "Error when posting star: " e)
       (internal-server-error "Error when posting star"))))

-(defn get-stars [{:keys [params] :as request}]
-  (try
-    (-> (:user-id params)
-        Integer/parseInt
-        stars/retrieve-starred-objectives
-        response/response
-        (response/content-type "application/json"))
-    (catch Exception e
-      (log/info "Error when getting starred objectives")
-      (invalid-response "Invalid starred objective get request"))))
-
 ;; OBJECTIVES
 (defn post-objective [request]
   (try


WIP on item listing unit tests.

WIP on item listing unit tests.

--- test/fcms/unit/resources/item/item_list.clj
+++ test/fcms/unit/resources/item/item_list.clj
@@ -7,5 +7,39 @@
 (with-state-changes [(before :facts (empty-collection-e))
                      (after :facts (collection/delete-collection e))]

-  (future-facts "about item listing failures")
-  (future-facts "about listing items"))+  (facts "about item listing failures"
+
+ 	  (facts "when the specified collection doesn't exist"
+      (doseq [coll-slug (conj bad-strings "not-here")]
+        (all-items coll-slug) => :bad-collection)))
+
+  (facts "about listing items"
+
+  	(fact "returns an empty vector when the collection is empty"
+  		(all-items e) => []))
+
+	(with-state-changes [(before :facts (existing-item-i))]
+
+		(fact "returns one item when there is one item in the collection"
+			(count (all-items e)) => 1)
+
+		(with-state-changes [(before :facts (create-item e slug))]
+
+			(fact "returns two items when there are two item in the collection"
+				(count (all-items e)) => 2)
+
+      (future-fact "the item ids are strings")
+
+      (future-fact "the containing collection's slug is included in the items")
+
+      (future-fact "the items' slugs are included")
+
+      (future-fact "the items' names are included")
+
+      (future-fact "the items' descriptions are included")
+
+      (future-fact "the items' versions are 1")
+
+      (future-fact "the custom property of an item in the list is included")
+
+      (future-fact "the item's timestamps are included"))))


reverting conj -> concat

reverting conj -> concat

--- src/io/aviso/rook.clj
+++ src/io/aviso/rook.clj
@@ -230,7 +230,8 @@
   ([namespace]
    (namespace-middleware rook-handler namespace))
   ([path namespace & handlers]
-   (let [handler (if (empty? handlers) rook-handler
-                   (apply compojure/routes (conj handlers rook-handler)))
+   (let [handler (if (empty? handlers)
+                   rook-handler
+                   (apply compojure/routes (concat handlers [rook-handler])))
          handler' (namespace-middleware handler namespace)]
      (compojure/context path [] handler'))))


pass "against" flag from start messages to matcher

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -212,14 +212,16 @@
 (defn initial-loop [{:keys [ch-in ch-out] :as player}]
   (go-loop []
     (when-let [msg (<! ch-in)]
-      (let [{:keys [type id]} msg
+      (let [{:keys [type id against]} msg
             reason (cond
                      (not= type "start")
                      "Only start messages allowed in current state"
                      (string/blank? id)
-                     "You need to include an id")]
+                     "You need to include an id"
+                     (#{"random" "perfect"} id)
+                     (format "\"%s\" is a reserved id used for a reference player" id))]
         (if-not reason
-          (>! @matcher (assoc player :id id))
+          (>! @matcher (assoc player :id id :against against))
           (do (put! ch-out {:type "ignored" :msg msg :reason reason})
               (recur)))))))


Fix a doc string

Fix a doc string

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -503,11 +503,11 @@

 (defn get-update-keys-taktil
   "Return the update keys for a given item (see `get-update-keys`).
-  For the ludo catalog we need to group all other formats under the
-  genre :bücher-über-spiel."
+  For the taktil catalog we need to group the :taktilesbuch items by
+  genre."
   [{fmt :format genre :genre :as item}]
   (cond
-    (= fmt :taktilesbuch) [fmt genre]
+    (#{:taktilesbuch} fmt) [fmt genre]
     :else (get-update-keys item)))

 (def ^:private sort-order


Make format determination robust against nil library-signature

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -248,7 +248,7 @@
         ;; tactile books aren't properly tagged in the format field.
         ;; They are tagged as :ludo and their library signature starts
         ;; with "TB"
-        fmt (if (and (= fmt :ludo) (re-find #"^TB " library-signature))
+        fmt (if (and (= fmt :ludo) library-signature (re-find #"^TB " library-signature))
               :taktilesbuch fmt)
         item (-> {}
                  (assoc-some


Always close out resources.

Always close out resources.

--- src/onyx/peer/task_pipeline.clj
+++ src/onyx/peer/task_pipeline.clj
@@ -119,13 +119,13 @@
       (>!! status-check-ch (munge-write-batch event))
       (recur))))

-(defn status-check-loop [status-ch ack-ch reset-payload-node-ch]
+(defn status-check-loop [status-ch ack-ch close-resources-ch]
   (loop []
     (when-let [event (<!! status-ch)]
       (let [event (munge-status-check event)]
         (if (:commit? event)
           (>!! ack-ch event)
-          (>!! reset-payload-node-ch event))
+          (>!! close-resources-ch event))
         (recur)))))

 (defn ack-loop [ack-ch commit-ch]
@@ -271,7 +271,7 @@
         :apply-fn-loop (thread (apply-fn-loop apply-fn-ch compress-batch-ch))
         :compress-batch-loop (thread (compress-batch-loop compress-batch-ch write-batch-ch))
         :write-batch-loop (thread (write-batch-loop write-batch-ch status-check-ch))
-        :status-check-loop (thread (status-check-loop status-check-ch ack-ch reset-payload-node-ch))
+        :status-check-loop (thread (status-check-loop status-check-ch ack-ch close-resources-ch))
         :ack-loop (thread (ack-loop ack-ch commit-tx-ch))
         :commit-tx-loop (thread (commit-tx-loop commit-tx-ch close-resources-ch))
         :close-resources-loop (thread (close-resources-loop close-resources-ch reset-payload-node-ch))


Fixed namespace in views.clj.

Fixed namespace in views.clj.

--- src/vertigo/views.clj
+++ src/vertigo/views.clj
@@ -1,4 +1,4 @@
-(ns views
+(ns vertigo.views
   (:use [hiccup.core]
         [hiccup.page-helpers]))


more tab killing

more tab killing

--- cljs/sledge/core.cljs
+++ cljs/sledge/core.cljs
@@ -283,34 +283,6 @@
                          {:init-state {:string ""}})
                (om/build results-view (:results search))))))

-(defn show-tab [cursor tab-name]
-  (om/update! cursor [:tab-on-view] [tab-name]))
-
-(defn tab-selector-view [app owner]
-  (reify
-    om/IRender
-    (render [this]
-      (let [on-view (om/observe owner (tab-on-view))]
-        (html
-         [:nav {}
-          [:ul {}
-           [:li {:onClick #(show-tab app :search)
-                 :className
-                 (if (= (first on-view) :search)
-                   "selected"
-                   "unselected")
-                 }
-            [:span {:id "show-library"} "library"]]
-           [:li
-            {:onClick #(show-tab app :player-queue)
-             :className
-             (if (= (first on-view) :player-queue)
-               "selected"
-               "unselected")
-             }
-            [:span  {:id "show-queue"} "queue"]]]])))))
-
-
 (defn music-in-queue? [tracknum]
   (let [queue (player-queue)]
     (nth queue tracknum nil)))


whitespace

whitespace

--- src/cheshire/core.clj
+++ src/cheshire/core.clj
@@ -50,7 +50,7 @@
          (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
        (gen/generate generator obj (or (:date-format opt-map)
                                        factory/default-date-format)
-                 (:ex opt-map))
+                     (:ex opt-map))
        (.flush generator)
        writer)))

@@ -69,7 +69,7 @@
                                            baos)]
        (gen/generate generator obj (or (:date-format opt-map)
                                        factory/default-date-format)
-                 (:ex opt-map))
+                     (:ex opt-map))
        (.flush generator)
        (.toByteArray baos))))


fix mistake that stopped stop button from working

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -460,8 +460,7 @@
         z (get-z-stage-position default-z-drive)
         xy (get-xy-stage-position default-xy-stage)
         exposure (core getExposure)]
-    (reset! (.state this)
-            {
+    (swap! (.state this) assoc
              :pause false
              :stop false
              :finished false
@@ -485,7 +484,6 @@
              :pixel-size-um (core getPixelSizeUm)
              :source (core getCameraDevice)
              :pixel-type (get-pixel-type)
-            }
       )))

 (defn cleanup []
@@ -743,6 +741,7 @@
   (let [out-queue (GentleLinkedBlockingQueue.)
         settings (convert-settings acq-settings)
         summary-metadata (make-summary-metadata settings)]
+    (reset! (.state this) nil)
     (swap! (.state this) assoc :summary-metadata summary-metadata)
     (let [acq-thread (Thread. #(run-acquisition this settings out-queue)
                               "Acquisition Engine Thread (Clojure)")


ip setup works

ip setup works

--- src/vsphere/guest.clj
+++ src/vsphere/guest.clj
@@ -6,6 +6,7 @@
   (:require
     [clj-http.client :as client])
   (:use
+    [celestial.provider :only (wait-for)]
     [celestial.common :only (gen-uuid import-logging)]
     [clostache.parser :only (render-resource)]
     [clojure.core.strint :only (<<)]
@@ -46,33 +47,38 @@

 (defn guest-run
   "Runs a remote command using out of band guest access,
-    log - true means logging will take place
     wait - how much to wait before logging output
-    uuid - the log file uuid
-  "
-  [hostname cmd args auth {:keys [uuid log wait]}]
+    uuid - the log file uuid, if missing no logging will take place"
+  [hostname cmd args auth uuid timeout]
   {:pre [(tools-installed? hostname)]}
   (with-service
     (let [m (manager hostname :proc)
-          args* (if log (<< "~{args} >> /tmp/run-~{uuid}.log") args)
-          spec (doto (GuestProgramSpec.) (.setProgramPath cmd) (.setArguments args*)) ]
-      (.startProgramInGuest m (npa auth) spec)))
-    (when log (Thread/sleep wait)
-         (debug (slurp (download-file (<< "/tmp/run-~{uuid}.log") hostname auth)))))
+          args* (if uuid (<< "~{args} >> /tmp/run-~{uuid}.log") args)
+          spec (doto (GuestProgramSpec.) (.setProgramPath cmd) (.setArguments args*))
+          pid (.startProgramInGuest m (npa auth) spec)]
+         (wait-for {:timeout timeout :sleep [200 :ms]}
+           #(-> (.listProcessesInGuest m (npa auth) (long-array [pid])) first bean :exitCode nil? not)
+           {:type ::vsphere:guest-run-timeout :message (<< "Timed out on running ~{cmd} ~{args} in guest") :timeout timeout} ))))

+(defn fetch-log
+   "fetched remote log file by uuid"
+   [hostname uuid auth]
+  (slurp (download-file (<< "/tmp/run-~{uuid}.log") hostname auth)))

 (defn set-ip
   "set guest static ip"
   [hostname auth config]
   (let [uuid (gen-uuid) tmp-file (<< "/tmp/intrefaces_~{uuid}")]
-    (upload-file (render-resource "static-ip.mustache" config) tmp-file  hostname auth)
-    (guest-run hostname "/bin/rm" (<< " -v ~{tmp-file}") auth {:uuid uuid :log true :wait 1000})))
+    (upload-file (render-resource "static-ip.mustache" config) tmp-file hostname auth)
+    (guest-run hostname "/bin/cp" (<< "-v ~{tmp-file} /etc/network/interfaces") auth uuid [2 :seconds])
+    (guest-run hostname "/usr/sbin/service" "networking restart" auth uuid [3 :seconds])
+    (guest-run hostname "/bin/rm" (<< "-v ~{tmp-file}") auth uuid [2 :seconds])
+    (debug (fetch-log hostname uuid auth))))

 (comment
-  (set-ip "foo" {:user "ronen" :pass "foobar"}
-          {:ip "192.168.5.6" :mask "255.255.255.0" :network "192.168.20.0" :gateway "192.168.20.254" :search "local" :names ["192.168.5.0"]})
-  (download-file "/tmp/project.clj" "/tmp/project.clj" "foo" {:user "ronen" :pass "foobar"})
-  (guest-run "foo" "/usr/bin/touch" "/tmp/foo" {:user "ronen" :pass "foobar"} {:uuid (gen-uuid) :log true :wait 1000})
+  (set-ip "foo" {:user "root" :pass "foobar"}
+     {:ip "192.168.5.91" :mask "255.255.255.0" :network "192.168.5.0" :gateway "192.168.5.1" :search "local" :names ["192.168.5.1"]})
+  (download-file "/tmp/project.clj" "/tmp/project.clj" "foo" {:user "root" :pass "foobar"})
   (upload-file "project.clj" "/tmp/project.clj" "foo" {:user "ronen" :pass "foobar"})
   (download-file "/tmp/project.clj" "/tmp/project.clj" "foo" {:user "ronen" :pass "foobar"})
   (tools-installed? "foo"))


Refactoring

Refactoring

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -35,11 +35,18 @@
              (or (not forfeit-cost) (not (empty? scored))))
       {:costs costs, :forfeit-cost forfeit-cost, :scored scored})))

+(defn build-spend-msg [cost-str verb]
+  (if (or (nil? cost-str)
+          (= "" cost-str))
+    (str verb "s ")
+    (str "spends " cost-str " to " verb " ")))
+
 (defn cost-names [value attr]
   (when (> value 0)
     (case attr
       :credit (str value " [$]")
-      :click  (->> "[Click]" repeat (take value) (apply str)))))
+      :click  (->> "[Click]" repeat (take value) (apply str))
+      nil)))

 (defn deduce [state side [attr value]]
   (swap! state update-in [side attr] (if (= attr :memory)
@@ -387,9 +394,7 @@
               (when msg
                 (let [desc (if (string? msg) msg (msg state side card targets))]
                   (system-msg state (to-keyword (:side card))
-                              (str (if (= "" cost-str)
-                                       "uses "
-                                       (str "spends " cost-str " to use "))
+                              (str (build-spend-msg cost-str "use")
                                    title (when desc (str " to " desc))))))
               (when effect (effect state side c targets))
               (when end-turn
@@ -1280,9 +1285,7 @@
          (when-let [cost-str (pay state side card :credit (:cost card) extra-cost
                               (when-not no-additional-cost additional-cost))]
            (let [c (move state side (assoc card :seen true) :play-area)]
-             (system-msg state side (if (= "" cost-str)
-                                     (str "plays " title)
-                                     (str "spends " cost-str " to play " title)))
+             (system-msg state side (str (build-spend-msg cost-str "play") title))
              (trigger-event state side (if (= side :corp) :play-operation :play-event) c)
              (if (has? c :subtype "Current")
                (do (doseq [s [:corp :runner]]
@@ -1357,7 +1360,7 @@
                  (system-msg state side "installs a card facedown" )
                (if custom-message
                  (system-msg state side custom-message)
-                 (system-msg state side (str (if (= "" cost-str) "installs " (str "spends " cost-str " to install ")) title
+                 (system-msg state side (str (build-spend-msg cost-str "install") title
                                           (when host-card (str " on " (:title host-card)))
                                           (when no-cost " at no cost")))))
                (trigger-event state side :runner-install installed-card)
@@ -1385,10 +1388,7 @@
              (update! state side (-> h
                                      (update-in [:zone] #(map to-keyword %))
                                      (update-in [:host :zone] #(map to-keyword %)))))
-           (system-msg state side (str (if (or (nil? cost-str)
-                                               (= "" cost-str))
-                                         "rez "
-                                         (str "spends " cost-str " to rez "))
+           (system-msg state side (str (build-spend-msg cost-str "rez")
                                        (:title card) (when no-cost " at no cost")))
            (when (#{"ICE"} (:type card)) (update-ice-strength state side card))
            (trigger-event state side :rez card))))
@@ -1419,10 +1419,8 @@
                      (trash state side prev-card {:keep-server-alive true})))
                  (let [card-name (if (or (= :rezzed install-state) (= :face-up install-state) (:rezzed c))
                                    (:title card) "a card")]
-                   (system-msg state side (str (if (= "" cost-str)
-                                                  "installs "
-                                                  (str "spends " cost-str " to install "))
-                                               card-name " in " server))
+                   (system-msg state side (str (build-spend-msg cost-str "install")
+                                                card-name " in " server)))
                  (let [moved-card (move state side c slot)]
                    (trigger-event state side :corp-install moved-card)
                    (when (= (:type c) "Agenda")
@@ -1430,7 +1428,7 @@
                    (when (= install-state :rezzed)
                      (rez state side moved-card {:no-cost true}))
                    (when (= install-state :face-up)
-                     (card-init state side (assoc (get-card state moved-card) :rezzed true) false)))))))))))
+                     (card-init state side (assoc (get-card state moved-card) :rezzed true) false))))))))))

 (defn play [state side {:keys [card server]}]
   (case (:type card)


extract header parsing

extract header parsing

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -4,6 +4,10 @@
   (:import (org.apache.http.entity ByteArrayEntity))
   (:import (org.apache.http.client.methods HttpGet HttpPut HttpPost HttpDelete))
   (:import (org.apache.http.impl.client DefaultHttpClient)))
+
+(defn parse-headers [http-resp]
+  (into {} (map (fn [h] [(.toLowerCase (.getName h)) (.getValue h)])
+                (iterator-seq (.headerIterator http-resp)))))

 (defn request
   "Executes the HTTP request corresponding to the given Ring request map and
@@ -32,9 +36,7 @@
         (let [http-resp (.execute http-client http-req)
               http-entity (.getEntity http-resp)
               resp {:status (.getStatusCode (.getStatusLine http-resp))
-                    :headers (into {} (map (fn [h] [(.toLowerCase (.getName h))
-                                                    (.getValue h)])
-                                           (iterator-seq (.headerIterator http-resp))))
+                    :headers (parse-headers http-resp)
                     :body (EntityUtils/toByteArray (.getEntity http-resp))}]
           (.shutdown (.getConnectionManager http-client))
           resp)))))


Improve look of history component

Improve look of history component

Signed-off-by: Christian Romney <78cb0763aa1664e7dd86fd558ae466f67ab17826@pointslope.com>

--- src/cljs/svg/app.cljs
+++ src/cljs/svg/app.cljs
@@ -96,16 +96,8 @@
   (let [h (r/cursor db [:states])
         current (r/cursor db [:current])]
     (fn [db]
-      [:div {:class "wrapper"}
-       [:button {:class "btn btn-default"
-                 :onClick (fn [e]
-                            (play-history @h :reverse))}
-        [:span {:class "glyphicon glyphicon-fast-backward"}]]
-       [:button {:class "btn btn-default"
-                 :onClick (fn [e]
-                            (play-history @h :forward))}
-        [:span {:class "glyphicon glyphicon-fast-forward"}]]
-       [:div {:class "form-group"}
+      [:div {:class "wrapper row"}
+       [:div {:class "form-group col-md-12"}
         [:label {:for "history"} (str "History " @current)]
         [:input {:type "range"
                  :class "form-control"
@@ -115,7 +107,18 @@
                  :max (count @h)
                  :on-change (fn [e]
                               (fire :history-navigated
-                                    (->> e .-target .-value js/parseInt)))}]]])))
+                                    (->> e .-target .-value js/parseInt)))}]]
+       [:div {:class "col-md-6"}
+        [:button {:class "btn btn-default"
+                  :onClick (fn [e]
+                             (play-history @h :reverse))}
+         [:span {:class "glyphicon glyphicon-fast-backward"}]]]
+       [:div {:class "col-md-6 text-right"}
+        [:button {:class "btn btn-default"
+                  :onClick (fn [e]
+                             (play-history @h :forward))}
+         [:span {:class "glyphicon glyphicon-fast-forward"}]]]
+       ])))

 (defn click-count-component
   [clicks]
@@ -209,12 +212,12 @@
     (fn []
       [:div {:id "wrapper"}
        [:div {:id "controls" :class "col-md-3"}
-        [history-component history]
         [click-count-component clicks]
         [range-component x 0 720 "CX"]
         [range-component y 0 720 "CY"]
         [range-component radius 1 100 "Size"]
-        [select-component fill]]
+        [select-component fill]
+        [history-component history]]
        [:div {:class "col-md-9"}
         [svg-component circle]]])))


removed comments

removed comments

--- src/vineyard/core.clj
+++ src/vineyard/core.clj
@@ -18,8 +18,6 @@
                           (string/join ", "))]
       (str fn-name "(" arg-string ")"))))

-;; parameters (seq String)
-;; body (vec Compileable)
 (defrecord AnonymousFunction [parameters body]
   Compile
   (compile [_]


Add default values for row and col to create-dashboard-card! :wrench:

--- src/metabase/models/dashboard_card.clj
+++ src/metabase/models/dashboard_card.clj
@@ -133,8 +133,8 @@
                                               :card_id                card_id
                                               :sizeX                  sizeX
                                               :sizeY                  sizeY
-                                              :row                    row
-                                              :col                    col
+                                              :row                    (or row 0)
+                                              :col                    (or col 0)
                                               :parameter_mappings     (or parameter_mappings [])
                                               :visualization_settings (or visualization_settings {}))]
         ;; add series to the DashboardCard


Add js-clj copy to more accurately log

Add js-clj copy to more accurately log

--- src-cljs/frontend/utils/ajax.cljs
+++ src-cljs/frontend/utils/ajax.cljs
@@ -7,6 +7,55 @@
             [frontend.async :refer [put!]]
             [frontend.utils :as utils :include-macros true])
   (:import [goog Uri]))
+
+(defn js->clj-copy
+  "Recursively transforms JavaScript arrays into ClojureScript
+  vectors, and JavaScript objects into ClojureScript maps.  With
+  option ':keywordize-keys true' will convert object fields from
+  strings to keywords.
+
+  This is an exact local copy of the core function so that I can add
+  appropriate logging to debug an issue."
+  ([x] (js->clj x :keywordize-keys false))
+  ([x & opts]
+    (let [{:keys [keywordize-keys]} opts
+          keyfn (if keywordize-keys keyword str)
+          f (fn thisfn [x]
+              (try
+                (cond
+                  (satisfies? IEncodeClojure x)
+                  (-js->clj x (apply array-map opts))
+
+                  (seq? x)
+                  (doall (map thisfn x))
+
+                  (coll? x)
+                  (into (empty x) (map thisfn x))
+
+                  (array? x)
+                  (vec (map thisfn x))
+
+                  (identical? (type x) js/Object)
+                  (into {} (for [k (js-keys x)]
+                             [(keyfn k) (thisfn (aget x k))]))
+
+                  :else x)
+                (catch :default e
+                  (js/console.log "JS->CLJ EXCEPTION START")
+                  (js/console.log (str "Exception: " e))
+                  (js/console.log x)
+                  (js/console.log
+                    (str "cond statement: "
+                         (cond
+                           (satisfies? IEncodeClojure x) "(satisfies? IEncodeClojure x)"
+                           (seq? x) "(seq? x)"
+                           (coll? x) "(coll? x)"
+                           (array? x) "(array? x)"
+                           (identical? (type x) js/Object) "(identical? (type x) js/Object)"
+                           :else ":else")))
+                  (js/console.log "JS->CLJ EXCEPTION STOP")
+                  (throw e))))]
+      (f x))))

 ;; https://github.com/JulianBirch/cljs-ajax/blob/master/src/ajax/core.cljs
 ;; copy of the default json formatter, but returns a map with json body
@@ -23,15 +72,13 @@
      :or {start-time (time/now)}}]
      {:read (fn read-json [xhrio]
               (let [json (js/JSON.parse (.getResponseText xhrio))
-                    _ (js/console.log "JSON PARSED: " json)
-                    headers (js->clj (.getResponseHeaders xhrio))
-                    _ (js/console.log (str "HEADERS PARSED: " headers))
+                    headers (js->clj-copy (.getResponseHeaders xhrio))
                     request-time (try
                                    (time/in-millis (time/interval start-time (time/now)))
                                    (catch :default e
                                      (utils/merror e)
                                      0))]
-                {:resp (js->clj json :keywordize-keys keywords?)
+                {:resp (js->clj-copy json :keywordize-keys keywords?)
                  :response-headers headers
                  :url url
                  :method method


Add back in the hiccup runtime so as not to be bustido.

--- src/posthere/cljs/posthere.cljs
+++ src/posthere/cljs/posthere.cljs
@@ -2,7 +2,8 @@
   "POSThere.io Cljs"
     (:require-macros [hiccups.core :refer (defhtml)])
     (:require   [jayq.core :refer ($ css html bind ajax)]
-                [clojure.string :as s]))
+                [clojure.string :as s]
+                [hiccups.runtime :as hiccupsrt]))

 ; index page
 (defn- update-uuid-value
@@ -27,7 +28,7 @@
                (f) (f) (f) (f) (f) (f) (f) (f) (f) (f) (f) (f))))))

 (defn- short-uuid []
-  "Take the middle 3 sections of a Java UUID to make a shorter UUID.
+  "Take the middle 3 sections of a UUID to make a shorter UUID.

   Ex: f6f7-499f-b805
   "


tabs.goto 8 goes to last tab

tabs.goto 8 goes to last tab

--- src/lt/objs/tabs.cljs
+++ src/lt/objs/tabs.cljs
@@ -558,9 +558,13 @@

 (cmd/command {:command :tabs.goto
               :hidden true
-              :desc "Tab: Goto tab #"
+              :desc "Tab: Goto tab #; 8 for last tab"
               :exec (fn [x]
-                      (object/raise (ctx/->obj :tabset) :tab x))})
+                      (let [ts (ctx/->obj :tabset)
+                            tabcount (count (:objs @ts))
+                            idx (dec tabcount)]
+                        (object/raise (ctx/->obj :tabset)
+                                      :tab (if (= x 8) idx x))))})

 (cmd/command {:command :tabset.next
               :desc "Tabset: Next tabset"


macros in :clj only

macros in :clj only

--- src/deferst/core.cljc
+++ src/deferst/core.cljc
@@ -56,48 +56,50 @@
               :sys-atom (atom nil)
               :default-conf default-conf
               :label label})))
+#?(:clj
+   (defn- make-name
+     [base-name suffix]
+     (->> [base-name suffix]
+          (filter identity)
+          (str/join "-")
+          symbol)))

-(defn- make-name
-  [base-name suffix]
-  (->> [base-name suffix]
-       (filter identity)
-       (str/join "-")
-       symbol))
-
-(defn- defsystem*
-  [base-name builder default-conf]
-  (let [name (make-name base-name "sys")
-        start-name (make-name base-name "start!")
-        system-map-name (make-name base-name "system-map")
-        stop-name (make-name base-name "stop!")
-        reload-name (make-name base-name "reload!")]
-    `(do
-       (def ~name (deferst/create-system
+#?(:clj
+   (defn- defsystem*
+     [base-name builder default-conf]
+     (let [name (make-name base-name "sys")
+           start-name (make-name base-name "start!")
+           system-map-name (make-name base-name "system-map")
+           stop-name (make-name base-name "stop!")
+           reload-name (make-name base-name "reload!")]
+       `(do
+          (def ~name (deferst/create-system
                        ~builder
                        ~default-conf
                        (symbol (name (ns-name *ns*)) (name '~name))))
-       (defn ~start-name
-         ([] (deferst/start! ~name))
-         ([conf#] (deferst/start! ~name conf#)))
-       (defn ~system-map-name [] (deferst/system-map ~name))
-       (defn ~stop-name [] (deferst/stop! ~name))
-       (defn ~reload-name []
-         (deferst/stop! ~name)
-         (tn/refresh
-          :after
-          (symbol
-           (name (ns-name *ns*))
-           (name '~start-name)))))))
+          (defn ~start-name
+            ([] (deferst/start! ~name))
+            ([conf#] (deferst/start! ~name conf#)))
+          (defn ~system-map-name [] (deferst/system-map ~name))
+          (defn ~stop-name [] (deferst/stop! ~name))
+          (defn ~reload-name []
+            (deferst/stop! ~name)
+            (tn/refresh
+             :after
+             (symbol
+              (name (ns-name *ns*))
+              (name '~start-name))))))))

-(defmacro defsystem
-  "macro which defs some vars around a system and provides
+#?(:clj
+   (defmacro defsystem
+     "macro which defs some vars around a system and provides
    easy tools-namespace reloading. you get

    <base-name>-sys - the Sys record
    <base-name>-start! - start the system, with optional config
    <base-name>-stop! - stop the system if running
    <base-name>-reload! - stop!, tools.namespace refresh, start!"
-  ([builder default-conf]
-   (defsystem* nil builder default-conf))
-  ([base-name builder default-conf]
-   (defsystem* base-name builder default-conf)))
+     ([builder default-conf]
+      (defsystem* nil builder default-conf))
+     ([base-name builder default-conf]
+      (defsystem* base-name builder default-conf))))


Implement visitFileFailed for mkvisitor

Implement visitFileFailed for mkvisitor

--- boot/pod/src/boot/tmpdir.clj
+++ boot/pod/src/boot/tmpdir.clj
@@ -100,7 +100,11 @@
                    (add-blob! blob path i link)
                    (swap! tree assoc p (map->TmpFile (assoc m :path p :id i :hash h :time t))))
                  (catch java.nio.file.NoSuchFileException _
-                   (util/dbug* "Tmpdir: file not found: %s\n" (.toString p))))) )))))
+                   (util/dbug* "Tmpdir: file not found: %s\n" (.toString p)))))))
+      (visitFileFailed [^Path path ^java.io.IOException e]
+        (with-let [_ fs/skip-subtree]
+          (let [p (str (.relativize root path))]
+            (util/dbug* "Tmpdir: failed to visit: %s\n" (.toString p))))))))

 (defn- dir->tree!
   [^File dir ^File blob]
@@ -263,7 +267,7 @@
                              err? (fatal-conflict? dst)
                              this (or (and (not err?) this)
                                       (update-in this [:tree] dissoc p))]
-                         (if err?
+                         (if err?
                            (util/warn "Merge conflict: not adding %s\n" p)
                            (do (util/trace* "Commit: adding   %s %s...\n" (id tmpf) p)
                                (file/hard-link src dst)))


tile and stage positioning

tile and stage positioning

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

--- plugins/SlideExplorer2/src/slide_explorer/display.clj
+++ plugins/SlideExplorer2/src/slide_explorer/display.clj
@@ -1,9 +1,9 @@
-(ns slide_explorer.display
+(ns slide-explorer.display
   (:import (javax.swing AbstractAction JComponent JFrame JLabel KeyStroke)
            (java.awt Canvas Color Graphics Graphics2D RenderingHints Window)
            (java.awt.event ComponentAdapter KeyAdapter KeyEvent MouseAdapter WindowAdapter)
            (java.awt.image BufferedImage WritableRaster)
-           (java.awt.geom AffineTransform)
+           (java.awt.geom AffineTransform Point2D$Double)
            (java.io ByteArrayInputStream)
            (java.util UUID)
            (java.util.prefs Preferences)
@@ -45,10 +45,37 @@
         h (get-image-height image)]
     [(long (* 3/4 w)) (long (* 3/4 h))]))

-;; tile to pixels
-
-(defn tile-
-
+;; tile/pixels
+
+(defn tile-locations-in-pixels [[nx ny] [tile-width tile-height]]
+  [(* nx tile-width) (* ny tile-height)])
+
+(defn round-int
+  "Round x to the nearest integer."
+  [x]
+  (Math/round (double x)))
+
+(defn tiles-in-pixel-rectangle
+  "Returns a list of tile indices found in a given pixel rectangle."
+  [[l t b r] [tile-width tile-height]]
+  (let [nl (round-int (/ l tile-width))
+        nr (round-int (/ r tile-width))
+        nt (round-int (/ t tile-height))
+        nb (round-int (/ b tile-height))]
+    (for [nx (range nl (inc nr))
+          ny (range nt (inc nb))]
+      [nx ny])))
+
+;; pixels/stage
+
+(defn pixels-to-stage [^AffineTransform transform [x y]]
+  (let [p (.transform transform (Point2D$Double. x y) nil)]
+    [(.x p) (.y p)]))
+
+(defn stage-to-pixels [^AffineTransform transform [x y]]
+  (let [p (.inverseTransform trasnform (Point2D$Double. x y) nil)]
+    [(.x p) (.y p)]))
+
 ;; tile image handling

 (defn main-window []


Default to 10 minute timeout

Default to 10 minute timeout

--- src/acyclic/awstools/core.clj
+++ src/acyclic/awstools/core.clj
@@ -292,7 +292,7 @@
   [reqmap nmin cmds & opts]
   (let [[opts [tot no-cancel?]] (extract-opts opts [:minutes :no-cancel])
         _  (debug opts tot no-cancel?)
-        tot (or tot 5)
+        tot (or tot 10)
         id  (.toString (UUID/randomUUID))
         cmd (str (send-up id) (clojure.string/join "\n" cmds) "\n")
         req (apply ph-assoc reqmap paths opts)


Comments

Comments

--- src/acyclic/awstools/core.clj
+++ src/acyclic/awstools/core.clj
@@ -247,6 +247,16 @@
    " sns publish --topic-arn " (or topic my-sns-topic)
    " --message `(echo \"id: " id "\";bin/ec2-metadata -i -p -o) | base64 -w 0`"
    "\n"))
+
+;(stop-instances :instance-ids ["i-7c949193"])
+;(modify-instance-attribute :instance-id "i-7c949193" :user-data (s->b64 "echo hello"))
+
+(defn good-strings [vs]
+  (and (sequential?  vs)
+       (every? string? vs)
+       (every? pos? (map count vs))))
+
+

 (defn- really-up? [rs->info rs]
   (let [info (get rs->info rs)]


mockup 'recent posts' and 'archive'

mockup 'recent posts' and 'archive'

--- src/yablog/server.clj
+++ src/yablog/server.clj
@@ -25,6 +25,20 @@
            [:h2 {:class "date"} (format-time (:date page))]]
           (tx/to-hiccup (slurp r)))))

+(defn recent-posts-box [req]
+  [:div {:class "sidebox"}
+   [:h2 "Recent posts"]
+   [:p "Things I can remember"]
+   [:ul (map (fn [n] [:li ,n]) (range 0 4))]])
+
+(defn by-month-box [req]
+  [:div {:class "sidebox"}
+   [:h2 "Archived posts"]
+   [:p "The tenured generation"]
+   [:ul (map (fn [n]
+               (vector :li n (map ytime/month-name (range 1 12))))
+             (range 2015 2001 -1))]])
+
 (defn stylify [hiccuper]
   (fn [req]
     (let [hic (hiccuper req)
@@ -43,6 +57,8 @@
          hic
          [:aside
           [:bio]
+          (recent-posts-box req)
+          (by-month-box req)]
          [:footer]
          ])))))


validation for disk-mode parameter

validation for disk-mode parameter

--- src/mirthsync/cli.clj
+++ src/mirthsync/cli.clj
@@ -64,7 +64,9 @@
             XML files.
         - code   : Default behavior. Expands everything to the most granular level
             (Javascript, Sql, etc)."
-    :default "code"]
+    :default "code"
+    :validate [#(contains? #{"backup" "groups" "items" "code"} %)
+               (str "Must be either backup, groups, items, or code")]]

    ["-r" "--restrict-to-path RESTRICT_TO_PATH" "
         A path within the target directory to limit the scope of the push. This


Fix website bug

Fix website bug

--- src/yada/resource.clj
+++ src/yada/resource.clj
@@ -19,7 +19,7 @@
 (extend-protocol Resourceful
   clojure.lang.Fn
   (resource [f ctx]
-    (let [res (f)]
+    (let [res (f ctx)]
       (if (d/deferrable? res)
         (d/chain res #(resource % ctx))
         (resource res ctx))))


cleanup (defn conjugate)

cleanup (defn conjugate)

--- src/babel/francais/morphology.cljc
+++ src/babel/francais/morphology.cljc
@@ -74,53 +74,33 @@
    unify-with. If lexicon is supplied, look up infinitive in lexicon and use exceptional form of
    first return value, if any."
   (if (nil? infinitive)
-    ""
-    (do
-      (log/debug (str "conjugate1: infinitive=" infinitive "; unify-with=" unify-with))
-      (let [exceptional-lexemes
-            (lookup-in lexicon
-                       {:spec {:français {:infinitive infinitive
-                                          :exception true}}})
-            exceptional-surface-forms
-            (map #(get-in % [:français :français])
-                 exceptional-lexemes)
-            regulars
-            (remove nil?
-                    (map
-                     (fn [replace-pattern]
-                       (let [from (nth (:g replace-pattern) 0)
-                             to (nth (:g replace-pattern) 1)
-                             unify-against (if (:u replace-pattern)
-                                             (:u replace-pattern)
-                                             :top)
-                             unified (unify unify-against
-                                            unify-with)]
-                         (when (and from to infinitive
-                                    (not (= :fail unified))
-                                    (re-matches from infinitive))
-                           (log/debug (str "infinitive: " infinitive " matched pattern: "
-                                           (strip-refs replace-pattern)))
-                           (let [output (string/replace infinitive from to)]
-                             (log/debug (str  "output: " output))
-                             output))))
-                     regular-patterns))
-
-            diagnostics (log/debug (str "emptyness of exceptions:" (empty? exceptional-surface-forms)))
-
-            diagnostics (log/debug (str "emptyness of regulars:" (empty? regulars)))
-            ;; Take the first of any exceptions found; if not, take the first regular conjugation.
-            ;; if neither, it's an error in this implementation of French morphology so throw so it can be
-            ;; detected and fixed.
-            results (take 1 (concat exceptional-surface-forms regulars))]
-        (not (empty? results))
-        (first results)
-
-        true
-        (do
-          (log/warn (str "no conjugation (irregular nor regular) was found for: " infinitive "; "
-                         "simply returning infinitive unconjugated."))
-          infinitive)))))
-
+    "" ;; TODO: throw error here
+    (let [exceptional-lexemes
+          (lookup-in lexicon
+                     {:spec {:français {:infinitive infinitive
+                                        :exception true}}})
+          exceptional-surface-forms
+          (map #(get-in % [:français :français])
+               exceptional-lexemes)
+
+          regulars
+          (remove nil?
+                  (map
+                   (fn [replace-pattern]
+                     (let [from (nth (:g replace-pattern) 0)
+                           to (nth (:g replace-pattern) 1)
+                           unify-against (if (:u replace-pattern)
+                                           (:u replace-pattern)
+                                           :top)
+                           unified (unify unify-against
+                                          unify-with)]
+                       (if (and from to infinitive
+                                (not (= :fail unified))
+                                (re-matches from infinitive))
+                         (string/replace infinitive from to))))
+                   regular-patterns))]
+      (first (take 1 (concat exceptional-surface-forms regulars [infinitive]))))))
+
 ;; TODO: separate part-of-speech -related functionality (e.g. the word is a verb) from
 ;; compositional functionality (e.g. the word has an :a and :b, so combine by concatenation, etc)
 ;;


replace complex wireframe with cube

replace complex wireframe with cube

--- app/views/viz/plot.cljs
+++ app/views/viz/plot.cljs
@@ -54,7 +54,8 @@
                 line-material
                 points
                 p-mat
-                w h ]} (om/get-state owner)
+                w h ]}
+        (om/get-state owner)
         new-line-geo (js/THREE.Geometry.)
         x-event (-> d3 (.extent datoms #(:x %)))
         y-event (-> d3 (.extent datoms #(:y %)))
@@ -78,59 +79,61 @@
             (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
             (v (x-scale (:x-cen vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts)))
             (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts)))
-            (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
-            (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
-            (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
-            (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
-            (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
-            (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts)))
+            ;; (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
+            ;; (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
+            ;; (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
+            ;; (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
+            ;; (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
+            ;; (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
             ]]
-     (doseq [v vs]
-       (-> new-line-geo .-vertices (.push v)))
-     (log/fine l "updating lineo geo")
-     (. scatter-plot (remove line))
-     (let [new-line (js/THREE.Line. new-line-geo
-                                    line-material
-                                    (.-Lines js/THREE))]
-       (.log js/console new-line)
-       (. scatter-plot (add new-line))
-       (om/set-state! owner :line new-line))
-
-     (let [point-geo (js/THREE.Geometry.)]
-       (doseq [d datoms]
-         (let [x (x-scale (:x d))
-               y (y-scale (:y d))
-               z (z-scale (:z d))]
-           (log/fine l d)
-           (-> point-geo .-vertices (.push (v x y z)))
-           (-> point-geo .-colors (.push (js/THREE.Color. (nth pressure-colours (int (:pressure d))))))))
-       (let [new-points (js/THREE.PointCloud. point-geo p-mat)]
-         (.log js/console )
-         (. scatter-plot (remove points))
-         (. scatter-plot (add new-points))
-         (om/set-state! owner :points new-points)
-
-         (.clear renderer)
-         (. camera (lookAt (.-position scene)))
-         (. renderer (render scene camera))
-         (.log js/console renderer)))))
+    (println vpts)
+    (println (x-scale (:x-max vpts)))
+    (doseq [v vs]
+      (-> new-line-geo .-vertices (.push v)))
+    (log/fine l "updating lineo geo")
+    (. scatter-plot (remove line))
+    (let [new-line (-> (js/THREE.BoxHelper. (js/THREE.Line. new-line-geo
+                                                            line-material
+                                                            (.-Lines js/THREE)))
+                       )]
+      (.log js/console new-line)
+      (. (aget new-line "material" "color") (set 0x000000))
+      (. scatter-plot (add new-line))
+      (om/set-state! owner :line new-line))
+
+    (let [point-geo (js/THREE.Geometry.)]
+      (doseq [d datoms]
+        (let [x (x-scale (:x d))
+              y (y-scale (:y d))
+              z (z-scale (:z d))]
+          (-> point-geo .-vertices (.push (v x y z)))
+          (-> point-geo .-colors (.push (js/THREE.Color. (nth pressure-colours (int (:pressure d))))))))
+      (let [new-points (js/THREE.PointCloud. point-geo p-mat)]
+        (. scatter-plot (remove points))
+        (. scatter-plot (add new-points))
+        (om/set-state! owner :points new-points)
+
+        (.clear renderer)
+        (. camera (lookAt (.-position scene)))
+        (. renderer (render scene camera))
+        (.log js/console renderer)))))

 (defn update-plot [e]
   (log/fine l "new datoms"))
@@ -143,7 +146,7 @@
    (let [w 950 h 500
          line-geo (js/THREE.Geometry.)
          line-material (js/THREE.LineBasicMaterial.  (clj->js  {:color 0x000000
-                                                                :lineWidth 2}))]
+                                                                :lineWidth 1}))]
      {:renderer (js/THREE.WebGLRenderer. (clj->js {:antialias true}))
       :camera (js/THREE.PerspectiveCamera. 45 (/ w h) 1 10000)
       :scene (js/THREE.Scene.)
@@ -171,11 +174,6 @@
        (events->chan js/window EventType.MOUSEUP up)
        (events->chan js/window EventType.MOUSEMOVE move)
        (go-loop [[event c] (alts! [down up move])]
-         (.log js/console event)
-         (.log js/console "up: " (= up c))
-         (.log js/console "down: " (= down c))
-         (.log js/console "move: " (= move c))
-         (.log js/console "c: " c)
          (condp = c
            down (do
                   (log/fine l "DOWN")
@@ -183,16 +181,12 @@
                   (om/set-state! owner :sx (.-clientX event))
                   (om/set-state! owner :sy (.-clientY event)))
            up (do
-                (log/fine l "UP")
+                (log/fine l "UP")
                 (om/set-state! owner :down false))
            move (when (om/get-state owner :down)
-                  (println (om/get-state owner))
                   (let [{:keys [sx sy]} (om/get-state owner)
                         dx (- (.-clientX event) sx)
                         dy (- (.-clientY event) sy)]
-                    (.log js/console sx sy)
-                    (.log js/console dx dy)
-                    (.log js/console (aget scatter-plot "rotation" "y"))
                     (aset scatter-plot "rotation" "y" (+ (aget scatter-plot "rotation" "y") (* dx 0.01)))
                     (aset camera "position" "y" (+ (aget camera "position" "y") dy))
                     (om/set-state! owner :sx (+ sx dx))
@@ -208,7 +202,7 @@
        (sub (:pub ws-chan) :post ws-sub-chan)
        (go-loop
            [[m c] (alts! [ws-sub-chan e-chan])]
-
+
          (when m
            (condp = c
              ws-sub-chan (do
@@ -232,7 +226,7 @@
      (render owner (om/get-state owner :datoms))
      (animate renderer camera scene (.getTime (js/Date.))))

-  )
+  )
   (render
    [_]
    (html [:div.plot-view {:ref "plot"}])))


Minor cosmetics

Minor cosmetics

--- src/freecoin/core.clj
+++ src/freecoin/core.clj
@@ -77,7 +77,9 @@
   (json/write-str data))

 (defn todo [_]
-  {:status 503 :body "Work-in-progress" :headers {"Content-Type" "text/html"}})
+  {:status 503
+   :body "Work-in-progress"
+   :headers {"Content-Type" "text/html"}})

 (defn handlers [config-m stores-m blockchain]
   (let [wallet-store (storage/get-wallet-store stores-m)


handle (string? (get-in input [:english]))

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -29,6 +29,9 @@

       (string? input)
       input
+
+      (string? (get-in input [:english]))
+      (get-in input [:english])

       (and (map? input)
            (map? (get-in input [:english])))


Added test-get-api-command with 5 test steps

--- test/emender_service/server_test.clj
+++ test/emender_service/server_test.clj
@@ -2,13 +2,16 @@
   (:require [clojure.test :refer :all]
             [emender-service.server :refer :all]))

-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))
-;(get-api-command nil)
-;(get-api-command "/v1")
-;(get-api-command "/v1/")
-;(get-api-command "/v1/job-started")
-;(get-api-command "/v1/job-started/")
-;(get-api-command "/v1/job-finished/jobNameName")
-;
+(def request
+    {:configuration {:api {:prefix "/v1"}}})
+
+(deftest test-get-api-command
+    (testing "Checks get-api-command-function"
+        (are [x y] (= x y)
+            nil            (get-api-command request nil)
+            nil            (get-api-command request "/v1")
+            "/job-started" (get-api-command request "/v1/job-started")
+            "/job-started" (get-api-command request "/v1/job-started/")
+            "/job-started" (get-api-command request "/v1/job-started/jobName")
+        )))
+


improved it

improved it

--- src/bluebell/utils/setdispatch.clj
+++ src/bluebell/utils/setdispatch.clj
@@ -128,11 +128,11 @@
                                          arity
                                          alternatives)))
       (< 1 (count frontier)) (throw
-                                                        (ex-info
-                                                         "Ambiguous set-based dispatch"
-                                                         (match-error-map
-                                                          arity
-                                                          matching-alternatives)))
+                              (ex-info
+                               "Ambiguous set-based dispatch"
+                               (match-error-map
+                                arity
+                                matching-alternatives)))
       :default (apply (-> frontier
                           first
                           :fn)
@@ -158,11 +158,19 @@
                       (check-not-used set-registry)
                       (apply f `(~set-registry ~@rest-args)))))))

+(defn arg-key [arg]
+  (select-keys arg [:query :binding]))
+
+(defn args-key [args]
+  (mapv arg-key args))
+
 (defn add-method [state-atom arity method]
   (swap! state-atom
          (fn [state]
            (update-in state [:dispatch-map arity]
-                      #(conj (or % {}) [(:args method) method])))))
+                      #(conj (or % {})
+                             [(args-key (:args method))
+                              method])))))

 (def memoized-evaluate-query (memoize ss/evaluate-query))


Handle site-url & mobile-site-url not being in env

Without this, gets a exception when loading due to calling re-pattern
on nil

--- src/braid/core/server/handler.clj
+++ src/braid/core/server/handler.clj
@@ -102,9 +102,13 @@
                               assoc-cookie-conf
                               assoc-csrf-conf))
            (wrap-restful-format :formats [:edn :transit-json])))
-      (wrap-cors :access-control-allow-origin [(re-pattern (env :site-url))
-                                               (re-pattern (env :mobile-site-url))
-                                               #"http://localhost:\d+"]
+      (wrap-cors :access-control-allow-origin (->>
+                                                [(when-let [site (env :site-url)]
+                                                   (re-pattern (java.util.regex.Pattern/quote site)))
+                                                 (when-let [mobile-site (env :mobile-site-url)]
+                                                   (re-pattern (java.util.regex.Pattern/quote mobile-site)))
+                                                 #"http://localhost:\d+"]
+                                                  (remove nil?))
                  :access-control-allow-credentials true
                  :access-control-allow-methods [:get :put :post :delete])
       wrap-edn-params))


fix syntax error

fix syntax error

--- src/brainbot/nozzle/esconnect.clj
+++ src/brainbot/nozzle/esconnect.clj
@@ -101,7 +101,7 @@
                "error"
                (get-in entry [:stat :type]))
        :mtime (get-in entry [:stat :mtime])))
-   entries)
+   entries))


Adjusted db pool connection timeout.

Adjusted db pool connection timeout.

--- src/hateoasql/dao.clj
+++ src/hateoasql/dao.clj
@@ -32,7 +32,8 @@
        :subprotocol db-type
        :subname (str "//" db-host ":" db-port "/" db-name)
        :user db-user
-       :password db-password}
+       :password db-password
+       :max-connection-lifetime 50 * 1000}
       )

         {:classname   "com.mysql.jdbc.Driver"


added understand (deeply) and understand (simply)

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -1048,7 +1048,19 @@
    "understand" {:english {:past "understood"}
                  :synsem {:cat :verb
                           :sem {:pred :understand}}}
-
+
+   "understand (deeply)" {:synsem {:cat :verb
+                            :sem {:pred :cenare}}
+                   :english {:present {:3sing "understands (deeply)"}
+                             :past "understood (deeply)"
+                             :participle "understanding (deeply)"}}
+
+"understand (simply)" {:synsem {:cat :verb
+                            :sem {:pred :cenare}}
+                   :english {:present {:3sing "understands (simply)"}
+                             :past "understood (simply)"
+                             :participle "understanding (simply)"}}
+
    "upload"  {:synsem {:cat :verb
                        :sem {:pred :caricare}}}


fix typo

fix typo

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -727,14 +727,13 @@

    "manage" {:synsem {:cat :verb
                 :sem {:pred :manage}}}
-
    "may"
    {:english {:past "might"
-              :present {:3sing "may"}
+              :present "may"
               :future "be able to"
               :conditional "might"}
-    :synsem {:cat :verb
-
+    :synsem {:cat :verb
+             :sem {:pred :may}}}
    "me"
    {:synsem {:cat :noun
              :pronoun true


There is only one page.

There is only one page.

--- src/circleci/web/views/common.clj
+++ src/circleci/web/views/common.clj
@@ -63,9 +63,9 @@
                [:div#header
                 [:h1#logo (link-to {:title "Go to CircleCI homepage"} "/" "CircleCI")]
                 (unordered-list {:id "nav"}
-                                [(link-to {:class "current_page"} ;; TODO - make current_page reflect reality
-                                          "/" "Home")
-                                 (link-to "/signup" "Signup page")])
+                                [(link-to {:class "current_page"}
+                                          "/" "Signup")
+                                 ])
                 [:div.clear]]]
               content
               [:div.clear]


Corrected namespace declaration

Corrected namespace declaration

--- src/clj/forma/hadoop/jobs/cdm.clj
+++ src/clj/forma/hadoop/jobs/cdm.clj
@@ -4,7 +4,7 @@
   (:use [cascalog.api]
         [forma.source.gadmiso :only (gadm->iso)]
         [forma.gfw.cdm :only (latlon->tile, read-string->num, latlon-valid?,
-                              meters->tile)]
+                              meters->maptile)]
         [forma.utils :only (positions)])
   (:require [forma.postprocess.output :as o]
             [forma.reproject :as r]


change Tennin Institute advancement to :placed true

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -332,7 +332,7 @@
    "Tennin Institute: The Secrets Within"
    {:abilities [{:msg "add 1 advancement counter on a card" :choices {:req #(= (first (:zone %)) :servers)}
                  :req (req (not (:successful-run runner-reg))) :once :per-turn
-                 :effect (effect (add-prop target :advance-counter 1))}]}
+                 :effect (effect (add-prop target :advance-counter 1 {:placed true}))}]}

    "The Foundry: Refining the Process"
    {:events


Fixed a typo in Hayley's prompt.

Fixed a typo in Hayley's prompt.

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -89,7 +89,7 @@
                          :effect (req (let [type (:type target)]
                                         (resolve-ability
                                           state side
-                                          {:prompt (msg "Choose a " type "to install")
+                                          {:prompt (msg "Choose a " type " to install")
                                            :choices (req (filter #(has? % :type type) (:hand runner)))
                                            :msg (msg "install " (:title target))
                                            :effect (effect (runner-install target))} card nil)))}}}}


add Dedication Ceremony score restriction; Mushin No Shin score/rez restrictions

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -192,7 +192,13 @@
    {:prompt "Choose a faceup card"
     :choices {:req rezzed?}
     :msg (msg "place 3 advancement tokens on " (card-str state target))
-    :effect (effect (add-prop :corp target :advance-counter 3 {:placed true}))}
+    :effect (effect (add-prop :corp target :advance-counter 3 {:placed true})
+                    (register-turn-flag!
+                      target :can-score
+                      (fn [state side card]
+                        (if (>= (:advance-counter card) (or (:current-cost card) (:advancementcost card)))
+                          ((constantly false) (toast state :corp "Cannot score due to Dedication Ceremony." "warning"))
+                          true))))}

    "Defective Brainchips"
    {:events {:pre-damage {:req (req (= target :brain)) :msg "to do 1 additional brain damage"
@@ -307,7 +313,17 @@
     :choices {:req #(and (#{"Asset" "Agenda" "Upgrade"} (:type %))
                          (= (:side %) "Corp")
                          (in-hand? %))}
-    :effect (effect (corp-install (assoc target :advance-counter 3) "New remote"))}
+    :effect (effect (corp-install (assoc target :advance-counter 3) "New remote")
+                    (register-turn-flag!
+                      target :can-rez
+                      (fn [state side card]
+                        ((constantly false) (toast state :corp "Cannot rez due to Mushin No Shin." "warning"))))
+                    (register-turn-flag!
+                      target :can-score
+                      (fn [state side card]
+                        (if (>= (:advance-counter card) (or (:current-cost card) (:advancementcost card)))
+                          ((constantly false) (toast state :corp "Cannot score due to Mushin No Shin." "warning"))
+                          true))))}

    "Mutate"
    {:req (req (seq (filter (every-pred rezzed? ice?) (all-installed state :corp))))


Updated Punitive Counterstrike's trace msg

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -340,8 +340,8 @@
                                      :effect (effect (add-prop target :advance-counter c {:placed true}))} card nil)))}

    "Punitive Counterstrike"
-   {:trace {:base 5 :msg (msg "do " (or (:stole-agenda runner-reg) 0) " meat damage")
-            :effect (effect (damage :meat (or (get-in runner [:register :stole-agenda]) 0) {:card card}))}}
+   {:trace {:base 5 :msg "do meat damage equal to agenda points stolen last turn"
+            :effect (effect (damage :meat (or (get-in runner [:register :stole-agenda]) 0) {:card card}) (system-msg (str "does " (or (:stole-agenda runner-reg) 0) " meat damage")))}}

    "Reclamation Order"
    {:prompt "Choose a card from Archives" :msg (msg "add copies of " (:title target) " to HQ")


Remove duration and rate widgets

Remove duration and rate widgets

--- src/cljs/gc_api_browser/form.cljs
+++ src/cljs/gc_api_browser/form.cljs
@@ -8,31 +8,13 @@
   (:import [goog.net XhrIo EventType]
            [goog json]))

-(defn handle-duration-change [form e]
-  (om/transact! form #(assoc form :duration (js/parseInt (.. e -target -value)))))
-
-(defn duration-selection [{:keys [duration] :as form}]
-  (dom/div #js {:className "request-form--field request-form--field__duration"}
-           (dom/div #js {:className "label"} "Duration:")
-           (dom/input #js {:className "input" :type "number" :value duration :min "1" :max "20" :step "1"
-                           :onChange (partial handle-duration-change form)})))
-
-(defn handle-rate-change [form e]
-  (om/transact! form #(assoc form :rate (js/parseInt (.. e -target -value)))))
-
-(defn rate-selection [{:keys [rate] :as form}]
-  (dom/div #js {:className "request-form--field request-form--field__rate"}
-           (dom/div #js {:className "label"} "Rate:")
-           (dom/input #js {:className "input" :type "number" :value rate :min "1" :max "20" :step "1"
-                           :onChange (partial handle-rate-change form)})))
-
-(defn handle-submit [{:keys [duration rate headers] :as form} {:keys [http-url] :as api}]
+(defn handle-submit [form api]
   (doto (XhrIo.)
     (events/listen EventType.SUCCESS #(.log js/console "SUCCESS" %))
     (events/listen EventType.ERROR #(.log js/console "ERROR" %))
     (.send (str "the-url") ;; FIXME
            "POST"
-           (.serialize json (clj->js (select-keys form [:url :method :headers :body :duration :rate])))
+           (.serialize json (clj->js (select-keys form [:url :method :headers :body])))
            #js {"Content-Type" "application/json"})))

 (defn submit-form [form api]
@@ -79,7 +61,5 @@
                                  (om/build headers/component (:headers form))
                                  (when (not= "GET" (:method form)) (edit-body form))
                                  (dom/div #js {:className "clearfix"})
-                                 (duration-selection form)
-                                 (rate-selection form)
                                  (submit-form form api)
                                  (dom/div #js {:className "clearfix"})))))))


Pretty-fy - I hope. Feel free to revert anything here.

--- src/cljs/onyx_dashboard/core.cljs
+++ src/cljs/onyx_dashboard/core.cljs
@@ -111,7 +111,7 @@
 ;; Components to start splitting out

 (defcomponent clojure-block [data owner]
-  (render-state [_ _] (dom/pre (:input data)))
+  (render-state [_ _] (dom/div (:input data)))
   (did-mount [_]
              (let [editor (.edit js/ace (om/get-node owner))]
                (.setOptions editor
@@ -163,23 +163,24 @@

 (defcomponent log-entries-table [{:keys [entries visible]} owner]
   (render [_]
-          (dom/pre (om/build section-header {:text "Cluster Activity"
-                                             :visible visible
-                                             :type :log-entries} {})
-                   (if visible
-                     (table {:striped? true :bordered? true :condensed? true :hover? true}
-                            (dom/thead (dom/tr (dom/th "ID") (dom/th "fn") (dom/th "Time")))
-                            (dom/tbody ;{:height "500px" :position "absolute" :overflow-y "scroll"}
-                                       (map (fn [entry]
-                                              (om/build log-entry-row entry {}))
-                                            entries)))))))
+          (p/panel
+           {:header (om/build section-header {:text "Cluster Activity"
+                                     :visible visible
+                                     :type :log-entries} {})}
+           (if visible
+             (table {:striped? true :bordered? true :condensed? true :hover? true}
+                    (dom/thead (dom/tr (dom/th "ID") (dom/th "fn") (dom/th "Time")))
+                    (dom/tbody ;{:height "500px" :position "absolute" :overflow-y "scroll"}
+                     (map (fn [entry]
+                            (om/build log-entry-row entry {}))
+                          entries)))))))

 (defcomponent job-selector [{:keys [selected-job jobs]} owner]
   (render [_]
-          (dom/pre
-            (dom/h4 "Jobs")
-            (table {:striped? true :bordered? true :condensed? true :hover? true}
-                   (dom/thead (dom/tr (dom/th "ID") (dom/th "Time")))
+          (p/panel
+           {:header (dom/h4 "Jobs")}
+            (table {:striped? true :bordered? false :condensed? true :hover? true}
+;;                   (dom/thead (dom/tr (dom/th "ID") (dom/th "Time")))
                    (dom/tbody
                      (for [job (reverse (sort-by :created-at (vals jobs)))]
                        (let [job-id (:id job)]
@@ -193,26 +194,26 @@

 (defcomponent catalog-view [catalog owner]
   (render [_]
-          (dom/pre (om/build ankha/collection-view catalog {:opts {:open? true}}))))
+          (dom/div (om/build ankha/collection-view catalog {:opts {:open? true}}))))

 (defcomponent job-info [{:keys [deployment visible]} owner]
   (render [_]
           (let [{:keys [selected-job jobs]} deployment]
             (if-let [job (and selected-job jobs (jobs selected-job))]
               (dom/div
-                (dom/pre
-                  (om/build section-header {:text "Catalog"
-                                            :visible (:job visible)
-                                            :type :job} {})
-                  (if (:job visible)
-                    (om/build clojure-block {:input (:pretty-catalog job)})))
-
-                (dom/pre
-                  (om/build section-header {:text "Workflow"
-                                            :visible (:workflow visible)
-                                            :type :workflow} {})
-                  (if (:workflow visible)
-                    (om/build clojure-block {:input (:pretty-workflow job)}))))))))
+               (p/panel
+                {:header (om/build section-header {:text "Catalog"
+                                          :visible (:job visible)
+                                          :type :job} {})}
+                (if (:job visible)
+                  (om/build clojure-block {:input (:pretty-catalog job)})))
+
+               (p/panel
+                {:header (om/build section-header {:text "Workflow"
+                                          :visible (:workflow visible)
+                                          :type :workflow} {})}
+                (if (:workflow visible)
+                  (om/build clojure-block {:input (:pretty-workflow job)}))))))))

 (defn success-notification [msg]
   (js/noty (clj->js {:text msg
@@ -240,15 +241,25 @@

   (render-state [_ {:keys [api-chan]}]
                 (dom/div
-                  (dom/aside {}
-                             (dom/nav {:class "left-nav-deployment" :style {:width left-bar-width :position "fixed"}}
-                                      (om/build select-deployment app {})
-                                      (om/build job-selector deployment {})))
-                  (dom/div {:style {:margin-left left-bar-width}}
-                           (om/build job-info {:deployment deployment
-                                               :visible visible} {})
-                           (om/build log-entries-table {:entries (deployment->latest-log-entries deployment)
-                                                        :visible (:log-entries visible)} {})))))
+                 (g/grid {}
+                         (r/page-header
+                          {}
+                          "Onyx Dashboard")
+                         (g/row
+                          {}
+                          (g/col
+                           {:xs 6 :md 4}
+                           (dom/aside {}
+                                      (dom/nav {:class "left-nav-deployment" :style {:width left-bar-width :position "fixed"}}
+                                               (om/build select-deployment app {})
+                                               (om/build job-selector deployment {}))))
+                          (g/col
+                           {:xs 12 :md 11 :md-push 1}
+                           (dom/div {:style {:margin-left left-bar-width}}
+                                    (om/build job-info {:deployment deployment
+                                                        :visible visible} {})
+                                    (om/build log-entries-table {:entries (deployment->latest-log-entries deployment)
+                                                                 :visible (:log-entries visible)} {}))))))))

 (defn main []
   (om/root


trying to clean the design

trying to clean the design

--- src/cljs/triboard/logic/move.cljs
+++ src/cljs/triboard/logic/move.cljs
@@ -99,19 +99,16 @@
 ;; Public API
 ;; -----------------------------------------

-;; TODO - Create a tree of reachable board (with their associated transition)
-;; TODO - Tree of board can be mapped to tree of trun
-;; TODO - Tree of turn can be mapped to tree of game
-;; TODO - Tree of game allows to move between games (play-move)
-;; TODO - Tree of game allows to move between ai fake games
-;; TODO => play-move becomes useless for the turn !
-;; TODO /!\ memory usage might explode? the tree will not be cut...
-;; TODO /!\ to avoid memory usage issue, we could just give a function to compute next moves...
-;;          but we have to break a cycle anyway... either with lazyness or functions
-
 #_(s/fdef available-transitions
     :args (s/tuple ::board/board)
     :ret ::available-moves)
+
+(defn all-transitions
+  [board]
+  (transduce
+    (mapcat #(available-conversions-at board %))
+    (utils/group-by-reducer :winner :point)
+    (board/empty-cells board)))

 (defn map-game-tree                                         ;; TODO - Maybe just get rid of the player?
   [xf game-tree]
@@ -121,9 +118,5 @@
   [board]
   (map-game-tree
     #(to-game-transition board (add-empty-cell-conversion %))
+    (all-transitions board)))

-    (transduce
-      (mapcat #(available-conversions-at board %))          ;; TODO - Cut that in two? (moves vs transitions)
-      (utils/group-by-reducer :winner :point)               ;; TODO - Move the game computation into turn computation for next turn
-      (board/empty-cells board))
-    ))


avoid cyclic dependency between LocalCluster and backtype.storm.clojure

--- src/clj/backtype/storm/clojure.clj
+++ src/clj/backtype/storm/clojure.clj
@@ -1,7 +1,7 @@
 (ns backtype.storm.clojure
   (:use [clojure.contrib.def :only [defnk defalias]])
   (:use [backtype.storm bootstrap util])
-  (:import [backtype.storm LocalCluster StormSubmitter])
+  (:import [backtype.storm StormSubmitter])
   (:import [backtype.storm.generated StreamInfo])
   (:import [backtype.storm.tuple Tuple])
   (:import [backtype.storm.task OutputCollector IBolt])
@@ -190,5 +190,7 @@
 (defn submit-remote-topology [name conf topology]
   (StormSubmitter/submitTopology name conf topology))

-(defn local-cluster []
-  (LocalCluster.))
+(defn local-cluster []
+  ;; do this to avoid a cyclic dependency of
+  ;; LocalCluster -> testing -> nimbus -> bootstrap -> clojure -> LocalCluster
+  (eval '(new backtype.storm.LocalCluster))


better docker api error info

better docker api error info

--- src/clj/swarmpit/docker/client.clj
+++ src/clj/swarmpit/docker/client.clj
@@ -81,7 +81,7 @@
             response-code (parse-http-code response)]
         (if (> 400 response-code)
           response-body
-          (throw (ex-info "Docker engine error!"
+          (throw (ex-info (str "Docker engine error: " (:message response-body))
                           {:status response-code
                            :body   {:error (:message response-body)}}))))
       (throw (ex-info "Docker client failure!"


Extract image-message making function

Extract image-message making function

--- src/cljs/openslack/views/text.cljs
+++ src/cljs/openslack/views/text.cljs
@@ -40,13 +40,17 @@
 ;; Images
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+(defn make-image-message
+  [url]
+  [:span
+   [:a {:href url} url]
+   [:br]
+   [:img {:src url
+          :class-name "message-image"}]])
+
 (def img-regex #"https?://.*\.(?:jpe?g|gif|png)")
-(defn img-converter
-  [url]
-  [:img {:src url
-         :class-name "message-image"}])
-
-(register-enricher! img-regex img-converter)
+
+(register-enricher! img-regex make-image-message)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; URLs
@@ -61,8 +65,7 @@
 (defmethod convert-http-url "imgur.com"
   [url]
   (let [uri (Uri. url)]
-    [:img {:src (str "http://i.imgur.com" (.getPath uri) ".jpg")
-           :class-name "message-image"}]))
+    (make-image-message (str "http://i.imgur.com" (.getPath uri) ".jpg"))))

 (defmethod convert-http-url :default
   [url]