sort ns form

sort ns form

--- sidecar/src/figwheel_sidecar/repl.clj
+++ sidecar/src/figwheel_sidecar/repl.clj
@@ -1,21 +1,21 @@
 (ns figwheel-sidecar.repl
   (:require
-   [figwheel-sidecar.cljs-utils.exception-parsing :as cljs-ex]
-   [strictly-specking-standalone.ansi-util :refer [with-color-when color]]
+   [cljs.analyzer :as ana]
+   [cljs.env :as env]
    [cljs.repl]
    [cljs.stacktrace]
-   [cljs.analyzer :as ana]
-   [cljs.env :as env]
    [cljs.util :refer [debug-prn]]
+   [clojure.core.async :refer [chan <!! <! put! alts!! timeout close! go go-loop]]
    [clojure.java.io :as io]
+   [clojure.pprint :as pp]
    [clojure.string :as string]
-   [clojure.core.async :refer [chan <!! <! put! alts!! timeout close! go go-loop]]
-
    [clojure.tools.nrepl.middleware.interruptible-eval :as nrepl-eval]
+
+   [figwheel-sidecar.cljs-utils.exception-parsing :as cljs-ex]
    [figwheel-sidecar.components.figwheel-server :as server]

    [figwheel-sidecar.config :as config]
-   [clojure.pprint :as pp])
+   [strictly-specking-standalone.ansi-util :refer [with-color-when color]]   )
   (:import [clojure.lang IExceptionInfo]))

 (defn eval-js [{:keys [browser-callbacks] :as figwheel-server} js]


remove some plugins

remove some plugins


have leiningen cleanup output after 'lein clean'

--- Clojure-Websockets/MainApp/project.clj
+++ Clojure-Websockets/MainApp/project.clj
@@ -42,10 +42,12 @@
             [quickie "0.3.6" :exclusions [org.clojure/clojure org.codehaus.plexus/plexus-utils]]
             [codox "0.8.10"]]

+  :clean-targets ^{:protect false} ["resources/public/js/build/"]
+
   :cljsbuild {:builds [{:id "dev"
                         :source-paths ["src/cljs"]
                         :compiler {:output-to "resources/public/js/build/birdwatch.js"
-                                   :output-dir "resources/public/js/build/out"
+                                   :output-dir "resources/public/js/build/dev-out"
                                    :optimizations :simple
                                    :externs ["externs/misc.js"]
                                    :source-map "resources/public/js/build/birdwatch.js.map"}}
@@ -61,6 +63,7 @@
                                    :output-dir "test-out/"
                                    :optimizations :simple
                                    :externs ["externs/react.js" "externs/misc.js"]}}]
+
               :test-commands {"unit-tests" ["phantomjs" :runner
                                             "resources/public/bower_components/react/react.js"
                                             "resources/public/bower_components/momentjs/moment.js"


(TK-2) Reorganize core namespace

(TK-2) Reorganize core namespace

This commit doesn't contain any code changes; it simply re-orders
the functions and adds some pragmas to try to make things a bit
more organized.

Conflicts:

	src/puppetlabs/trapperkeeper/services/webserver/jetty9_core.clj

--- src/puppetlabs/trapperkeeper/services/webserver/jetty9_core.clj
+++ src/puppetlabs/trapperkeeper/services/webserver/jetty9_core.clj
@@ -1,9 +1,4 @@
-;; NOTE: this code is an adaptation of ring-jetty-handler.
-;;  It adds some SSL utility functions, and
-;;  provides the ability to dynamically register ring handlers.
-
 (ns puppetlabs.trapperkeeper.services.webserver.jetty9-core
-  "Adapter for the Jetty webserver."
   (:import (org.eclipse.jetty.server Handler Server Request ServerConnector
                                      HttpConfiguration HttpConnectionFactory
                                      ConnectionFactory)
@@ -85,18 +80,24 @@
   [webserver-context :- WebserverServiceContext]
   (instance? Server (:server webserver-context)))

-(defn- ring-handler
-  "Returns an Jetty Handler implementation for the given Ring handler."
-  [handler]
-  (proxy [AbstractHandler] []
-    (handle [_ ^Request base-request request response]
-      (let [request-map  (servlet/build-request-map request)
-            response-map (handler request-map)]
-        (when response-map
-          (servlet/update-servlet-response response response-map)
-          (.setHandled base-request true))))))
-
-; TODO: move
+(sm/defn ^:always-validate
+  merge-webserver-overrides-with-options :- config/WebserverServiceRawConfig
+  "Merge any overrides made to the webserver config settings with the supplied
+   options."
+  [webserver-context :- WebserverServiceContext
+   options :- config/WebserverServiceRawConfig]
+  {:post [(map? %)]}
+  (let [overrides (:overrides (swap! (:state webserver-context)
+                                     assoc
+                                     :overrides-read-by-webserver
+                                     true))]
+    (doseq [key (keys overrides)]
+      (log/info (str "webserver config overridden for key '" (name key) "'")))
+    (merge options overrides)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; SSL Context Functions
+
 (sm/defn ^:always-validate
   ssl-context-factory :- SslContextFactory
   "Creates a new SslContextFactory instance from a map of options."
@@ -114,13 +115,15 @@
       nil)
     context))

-; TODO move to a better section of the file
 (sm/defn ^:always-validate
   get-proxy-client-context-factory :- SslContextFactory
   [ssl-config :- config/WebserverSslPemConfig]
   (-> ssl-config
       config/pem-ssl-config->keystore-ssl-config
       (ssl-context-factory :none)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Jetty Server / Connector Functions

 (defn- connection-factory
   []
@@ -146,6 +149,31 @@
   (doto (ServerConnector. server (connection-factory))
     (.setPort (:port config))
     (.setHost (:host config))))
+
+(sm/defn ^:always-validate
+  create-server :- Server
+  "Construct a Jetty Server instance."
+  [webserver-context :- WebserverServiceContext
+   config :- config/WebserverServiceConfig]
+  (let [server (Server. (QueuedThreadPool. (:max-threads config)))]
+    (when (:http config)
+      (let [connector (plaintext-connector server (:http config))]
+        (.addConnector server connector)))
+    (when-let [https (:https config)]
+      (let [ssl-ctxt-factory (ssl-context-factory
+                               (:keystore-config https)
+                               (:client-auth https))
+            connector (ssl-connector server ssl-ctxt-factory https)]
+        (when-let [ciphers (:cipher-suites https)]
+          (.setIncludeCipherSuites ssl-ctxt-factory (into-array ciphers)))
+        (when-let [protocols (:protocols https)]
+          (.setIncludeProtocols ssl-ctxt-factory (into-array protocols)))
+        (.addConnector server connector)
+        (swap! (:state webserver-context) assoc :ssl-context-factory ssl-ctxt-factory)))
+    server))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; GZip Functions

 ;; TODO: make all of this gzip-mime-type stuff configurable
 (defn- gzip-excluded-mime-types
@@ -172,6 +200,27 @@
     (.setHandler handler)
     (.setMimeTypes (gzip-excluded-mime-types))
     (.setExcludeMimeTypes true)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Handler Helper Functions
+
+(sm/defn ^:always-validate
+  add-handler :- ContextHandler
+  [webserver-context :- WebserverServiceContext
+   handler :- ContextHandler]
+  (.addHandler (:handlers webserver-context) handler)
+  handler)
+
+(defn- ring-handler
+  "Returns an Jetty Handler implementation for the given Ring handler."
+  [handler]
+  (proxy [AbstractHandler] []
+    (handle [_ ^Request base-request request response]
+      (let [request-map  (servlet/build-request-map request)
+            response-map (handler request-map)]
+        (when response-map
+          (servlet/update-servlet-response response response-map)
+          (.setHandled base-request true))))))

 (sm/defn ^:always-validate
   proxy-servlet :- ProxyServlet
@@ -210,26 +259,15 @@
 ;;; Public

 (sm/defn ^:always-validate
-  create-server :- Server
-  "Construct a Jetty Server instance."
-  [webserver-context :- WebserverServiceContext
-   config :- config/WebserverServiceConfig]
-  (let [server (Server. (QueuedThreadPool. (:max-threads config)))]
-    (when (:http config)
-      (let [connector (plaintext-connector server (:http config))]
-        (.addConnector server connector)))
-    (when-let [https (:https config)]
-      (let [ssl-ctxt-factory (ssl-context-factory
-                               (:keystore-config https)
-                               (:client-auth https))
-            connector (ssl-connector server ssl-ctxt-factory https)]
-        (when-let [ciphers (:cipher-suites https)]
-          (.setIncludeCipherSuites ssl-ctxt-factory (into-array ciphers)))
-        (when-let [protocols (:protocols https)]
-          (.setIncludeProtocols ssl-ctxt-factory (into-array protocols)))
-        (.addConnector server connector)
-        (swap! (:state webserver-context) assoc :ssl-context-factory ssl-ctxt-factory)))
-    server))
+  initialize-context :- WebserverServiceContext
+  "Create a webserver-context which contains a HandlerCollection and a
+  ContextHandlerCollection which can accept the addition of new handlers
+  before the webserver is started."
+  []
+  (let [^ContextHandlerCollection chc (ContextHandlerCollection.)]
+    {:handlers chc
+     :state (atom {})
+     :server nil}))

 ; TODO move out of public
 (sm/defn ^:always-validate
@@ -297,17 +335,6 @@
     (.setHandler s (gzip-handler hc))
     (assoc webserver-context :server s)))

-(sm/defn ^:always-validate
-  initialize-context :- WebserverServiceContext
-  "Create a webserver-context which contains a HandlerCollection and a
-  ContextHandlerCollection which can accept the addition of new handlers
-  before the webserver is started."
-  []
-  (let [^ContextHandlerCollection chc (ContextHandlerCollection.)]
-    {:handlers chc
-     :state (atom {})
-     :server nil}))
-
 (sm/defn ^:always-validate start-webserver! :- WebserverServiceContext
   "Creates and starts a webserver.  Returns an updated context map containing
   the Server object."
@@ -324,13 +351,6 @@
         (shutdown webserver-context)
         (throw e)))
     webserver-context))
-
-(sm/defn ^:always-validate
-  add-handler :- ContextHandler
-  [webserver-context :- WebserverServiceContext
-   handler :- ContextHandler]
-  (.addHandler (:handlers webserver-context) handler)
-  handler)

 (sm/defn ^:always-validate
   add-context-handler :- ContextHandler


CMR-6138: Worked around the jts-core lib conflict issue between ES and shape file integration.

--- common-lib/project.clj
+++ common-lib/project.clj
@@ -38,6 +38,9 @@
                  [org.eclipse.jetty/jetty-io "9.4.14.v20181114"]
                  [org.eclipse.jetty/jetty-servlets "9.4.14.v20181114"]
                  [org.eclipse.jetty/jetty-util "9.4.14.v20181114"]
+                 ;; load jts core lib first to make sure it is available for shapefile integration,
+                 ;; otherwise ES referenced 1.15.0 version will be mistakenly picked for shapefile
+                 [org.locationtech.jts/jts-core "1.16.1"]
                  [org.ow2.asm/asm "7.0"]
                  [potemkin "0.4.5"]
                  [ring/ring-core "1.7.1"]


refactor morph: seperate handleClick fn

refactor morph: seperate handleClick fn

--- src-cljs/cljs_workspace/om_morph.cljs
+++ src-cljs/cljs_workspace/om_morph.cljs
@@ -8,6 +8,7 @@
             [goog.style :as gstyle]
             [goog.dom :as gdom]
             [cljs-workspace.draggable :as draggable :refer [clicked-morph]]
+            [cljs-workspace.branch-merge :as branch-merge]
             ; [clojure.browser.repl :as repl]
             )
   (:import [goog.events EventType]))
@@ -114,6 +115,13 @@
         (dom/div  #js {:style style
                      :className "morphNode" } (shape app owner))))))

+(defn handle-click [e state]
+  ; add/remove morph from preserve list
+  ; (branch-merge/toggle-preserve state)
+  ; handle the custom behavior
+  (when-let [cb (get-in state [:morph :onClick])]
+              (cb state)))
+
 (defmethod morph :default [app owner]
   (reify
     om/IRender
@@ -121,7 +129,7 @@
       (let [style (dict->js (extract-style (:morph app)))]
         (dom/div  #js {:style style
                      :className "morphNode"
-                     :onClick #(when-let [cb (get-in @app [:morph :onClick])] (cb (@app :morph)))
+                     :onClick #(handle-click % @app)
                      :onMouseDown #(draggable/start-dragging % app owner)
                      :onMouseUp #(draggable/stop-dragging % app)
                     }


fix flickering cursor over name change when broadcasting

--- src-cljs/frontend/components/hud.cljs
+++ src-cljs/frontend/components/hud.cljs
@@ -255,7 +255,7 @@
                   (or self-name "You")]
                  [:div.viewer-controls
                   (when (:recording sub)
-                    [:div.viewer-symbols
+                    [:div.viewer-symbols.holo
                      [:div.viewer-symbol
                       (volume-icon (get-in sub [:recording :media-stream-volume] 0) (name self-color))]])
                   [:div.viewer-toggles


Fixing the UMM Spec library project.clj

Fixing the UMM Spec library project.clj

--- umm-spec-lib/project.clj
+++ umm-spec-lib/project.clj
@@ -20,12 +20,12 @@

          ;; The ^replace is done to disable the tiered compilation for accurate benchmarks
          ;; See https://github.com/technomancy/leiningen/wiki/Faster
-         :jvm-opts ^:replace ["-server"
-                              ;; Use the following to enable JMX profiling with visualvm
-                              "-Dcom.sun.management.jmxremote"
-                              "-Dcom.sun.management.jmxremote.ssl=false"
-                              "-Dcom.sun.management.jmxremote.authenticate=false"
-                              "-Dcom.sun.management.jmxremote.port=1098"]
+         ; :jvm-opts ^:replace ["-server"
+         ;                      ;; Use the following to enable JMX profiling with visualvm
+         ;                      "-Dcom.sun.management.jmxremote"
+         ;                      "-Dcom.sun.management.jmxremote.ssl=false"
+         ;                      "-Dcom.sun.management.jmxremote.authenticate=false"
+         ;                      "-Dcom.sun.management.jmxremote.port=1098"]

          :source-paths ["src" "dev" "test"]
          :injections [(require 'pjstadig.humane-test-output)


Update chart logger; fix spelling

Update chart logger; fix spelling

--- clojure/src/evolution_programs/logging/chart.clj
+++ clojure/src/evolution_programs/logging/chart.clj
@@ -70,7 +70,7 @@
 (defn logger
   ([]
    (let [analysis-dataset (DefaultBoxAndWhiskerCategoryDataset.)]
-     (frame "Popluation Analysis" analysis-dataset)
+     (frame "Population Analysis" analysis-dataset)
      (partial log-generation analysis-dataset)))
   ([f min max samples]
    (let [sample-dataset (sample f min max samples)


Update atom_patch_test.clj

Update atom_patch_test.clj

--- test/atom_finder/atom_patch_test.clj
+++ test/atom_finder/atom_patch_test.clj
@@ -8,7 +8,6 @@
             [atom-finder.classifier :refer :all]
             [clj-jgit.porcelain  :as gitp]
             [clojure.pprint :refer :all]
-            [clojure.data.json :as json]
             ))

 (deftest removed-lines-test


tests

tests

--- src/clj/algorithms_clj/derivative.clj
+++ src/clj/algorithms_clj/derivative.clj
@@ -62,5 +62,7 @@
   (prn (derivative (list '+ 'x 1) 'x))
   (prn (derivative `(+ x 1) `x))
   (prn (derivative `(* x 2) `x))
+
+  (prn (derivative `(+ x (* x x y)) `x))
   )


mutation. "state sharing" beween "root" and "tab" components

--- src/cljs/omnext_routing_one/core.cljs
+++ src/cljs/omnext_routing_one/core.cljs
@@ -168,7 +168,8 @@
   static om/IQuery
   (query [_]
          '[:tab-key/oceans
-           :oceans]
+           :oceans
+           :selected-ocean]
          )

   Object
@@ -176,7 +177,12 @@
           (apply dom/ul nil
                  (map (fn [ocean]
                         (dom/li nil
+                                ((if (= (:selected-ocean (om/props this))
+                                       ocean
+                                       )
+                                   dom/strong dom/span) nil
                                 ocean
+                                  )
                                 )
                         )
                       (:oceans (om/props this))
@@ -260,18 +266,32 @@
 ;; Components

+(def root-own-params
+  {}
+  )
+
+(def root-own-query
+  '[:oceans
+    :selected-ocean]
+  )
+
 (def routes-chan (chan))

 (defui RootView
   static om/IQueryParams
   (params [_]
-          initial-params ; here and below, we're passing (pre-computed) value
-                         ; and not doing function calls
+          (merge
+            initial-params
+            root-own-params
+            )
     )

   static om/IQuery
   (query [_]
-         initial-query
+         (vec (concat
+           initial-query
+           root-own-query
+           ))
     )

   Object
@@ -279,7 +299,11 @@
                      (go-loop [new-query (<! routes-chan)]
                                 (om/set-query!
                                   this
-                                  new-query
+                                  {:query
+                                   (-> new-query :query (concat root-own-query) vec)
+                                   :params
+                                   (-> new-query :params (merge root-own-params)) ;; TODO: this weren't checked
+                                   }
                                   )
                               (recur (<! routes-chan))
                        )
@@ -308,6 +332,20 @@
                                 )
                 ]
             (dom/div #js {:className "container"}
+                     ;; The custom component
+                     (dom/div nil
+                         "Selected ocean:"
+                         (:selected-ocean (om/props this))
+                         (dom/button #js {:className "btn btn-default"
+                                          :onClick (fn [e]
+                                                     (om/transact! this `[(~'select-random-ocean
+                                                                           {:current-oceans
+                                                                            ~(:oceans (om/props this))
+                                                                            }
+                                                                           )])
+                                                     )
+                                          } "Select random ocean")
+                              )
                      ;; Tabs (navigation)
                         (apply dom/ul
                         #js
@@ -392,10 +430,22 @@

 (defmulti mutatef om/dispatch)

+
+(defmethod mutatef 'select-random-ocean
+  [{:keys [state] :as env} k {:keys [current-oceans] :as params}]
+  {:action
+   (fn []
+     (swap! state #(assoc % :selected-ocean
+             (rand-nth (vec current-oceans))
+             ))
+     )}
+  )
+
 ;; Root

 (def data {
            :countries (js->clj js/COUNTRIES_LIST :keywordize-keys true)
+           :selected-ocean nil
            :oceans ["Pacific" "Atlantic" "Indian" "Southern" "Arctic"]
            :hello "Hello, world! What's up?"
            })


Ignore empty maps sent as ping

Ignore empty maps sent as ping

--- src/b3api/core.clj
+++ src/b3api/core.clj
@@ -53,14 +53,18 @@
         key         (:key data-map)
         new-message (dissoc data-map :key)]
     ;; Because authentication
-    (if (and key (some #{key} @tokens))
+    (if (and key
+             (some #{key} @tokens))
       (do
         (log/info "New update!")
         (broadcast! (generate-string new-message))
+
         ;; TODO: append to log file
         (swap! status merge new-message)
         (write-status-json!))
-      (log/info "Not authenticated!"))))
+
+      (when-not (= data-map {}) ;; Ignore empty maps sent as ping
+        (log/warn "Not authenticated!")))))

 (defn update-handler


Add strategic ^dynamic annotations for 1.3

--- server/src/main/clojure/vimclojure/repl.clj
+++ server/src/main/clojure/vimclojure/repl.clj
@@ -29,7 +29,7 @@
      (clojure.lang Var Compiler LineNumberingPushbackReader)))

 (def
-  #^{:doc
+  ^{:dynamic true :doc
   "A map holding the references to all running repls indexed by their repl id."}
   *repls*
   (atom {}))
@@ -41,7 +41,7 @@
     (swap! id inc)))

 (def
-  #^{:doc
+  ^{:dynamic true :doc
   "Set to true in the Repl if you want pretty printed results. Has no effect
   if clojure.contrib.pprint is not available."}
   *print-pretty*


Public docs for reitit.segment

Public docs for reitit.segment

--- modules/reitit-core/src/reitit/segment.cljc
+++ modules/reitit-core/src/reitit/segment.cljc
@@ -48,16 +48,20 @@
 ;; public api
 ;;

-(defn insert [root path data]
-  #?(:cljs (-insert (or root (segment)) (impl/segments path) (map->Match {:data data}))
-     :clj  (.add (or ^SegmentTrie root ^SegmentTrie (SegmentTrie.)) ^String path data)))
+(defn insert
+  "Returns a Segment Trie with path with data inserted into it. Creates the trie if `nil`."
+  [trie path data]
+  #?(:cljs (-insert (or trie (segment)) (impl/segments path) (map->Match {:data data}))
+     :clj  (.add (or ^SegmentTrie trie ^SegmentTrie (SegmentTrie.)) ^String path data)))

-(defn compile [segment]
-  #?(:cljs segment
-     :clj  (.matcher ^SegmentTrie (or segment (SegmentTrie.)))))
+(defn compile [trie]
+  "Compiles the Trie so that [[lookup]] can be used."
+  #?(:cljs trie
+     :clj  (.matcher ^SegmentTrie (or trie (SegmentTrie.)))))

-(defn lookup [segment path]
-  #?(:cljs (if-let [match (-lookup segment (impl/segments path) {})]
+(defn lookup [trie path]
+  "Looks the path from a Segment Trie. Returns a [[Match]] or `nil`."
+  #?(:cljs (if-let [match (-lookup trie (impl/segments path) {})]
              (assoc match :path-params (impl/url-decode-coll (:path-params match))))
-     :clj  (if-let [match ^SegmentTrie$Match (SegmentTrie/lookup segment path)]
+     :clj  (if-let [match ^SegmentTrie$Match (SegmentTrie/lookup trie path)]
              (->Match (.data match) (clojure.lang.PersistentHashMap/create (.params match))))))


adjusting docs casing

adjusting docs casing

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -120,15 +120,15 @@
   (GET- "/user/:name" [^:string name] {:nickname "getUser" :summary "Get User"}
         (success (p/get-user name)))

-  (POST- "/user/" [& ^:user user] {:nickname "addUser" :summary "adds a new user"}
+  (POST- "/user/" [& ^:user user] {:nickname "addUser" :summary "Adds a new user"}
          (p/add-user (-> user convert-roles hash-pass))
          (success {:msg "added user"}))

-  (PUT- "/user/" [& ^:user user] {:nickname "updateUser" :summary "updates an existing user"}
+  (PUT- "/user/" [& ^:user user] {:nickname "updateUser" :summary "Updates an existing user"}
         (p/update-user (-> user convert-roles hash-pass))
         (success {:msg "user updated"}))

-  (DELETE- "/user/:name" [^:string name] {:nickname "deleteUser" :summary "deleted a user"}
+  (DELETE- "/user/:name" [^:string name] {:nickname "deleteUser" :summary "Deleted a user"}
            (p/delete-user name)
            (success {:msg "user deleted" :name name})))


It was just the print statements lol

It was just the print statements lol


Add first kinda-working implementation of OAuth2 token fetching


fix path->permalink if out-dir is set to "."


Don't need nil test in vis-html-actx.

Don't need nil test in vis-html-actx.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -119,39 +119,36 @@
 ;; ------------------------------------------------

 (defn vis-html-actx [vis actx actx-ch-ch-infos]
-  (if actx
-    (let [chs (:chs vis)
-          actx-info (get-in vis [:actxs actx])
-          children (:children actx-info)
-          wait-chs (:wait-chs actx-info)]
-      ["
" (last actx)
-       (if (not-empty wait-chs)
-         [" -- waiting: ("
-          (map (fn [kv]
-                 (let [[ch wait-kind] kv]
-                   [(:id (get chs ch)) wait-kind ", "]))
-               wait-chs)
-          ")"]
-         [])
-       "
"
-       "
"
-       (map (fn [ch-ch-info]
-              (let [ch-info (second ch-ch-info)]
-                ["
" (:id ch-info) ": " (:msgs ch-info) "
"]))
-            (get actx-ch-ch-infos actx))
-       "
"
-       "
"
-       (if (not-empty children)
-         ["
"
-          (map (fn [child-actx-bool] ["
"
-                                      (vis-html-actx vis (first child-actx-bool)
-                                                     actx-ch-ch-infos)
-                                      "
"])
-               children)
-          "
"]
-         [])
-       "
"])
-    "no actx"))
+  (let [chs (:chs vis)
+        actx-info (get-in vis [:actxs actx])
+        children (:children actx-info)
+        wait-chs (:wait-chs actx-info)]
+    ["
" (last actx)
+     (if (not-empty wait-chs)
+       [" -- waiting: ("
+        (map (fn [kv]
+               (let [[ch wait-kind] kv]
+                 [(:id (get chs ch)) wait-kind ", "]))
+             wait-chs)
+        ")"]
+       [])
+     "
"
+     "
"
+     (map (fn [ch-ch-info]
+            (let [ch-info (second ch-ch-info)]
+              ["
" (:id ch-info) ": " (:msgs ch-info) "
"]))
+          (get actx-ch-ch-infos actx))
+     "
"
+     "
"
+     (if (not-empty children)
+       ["
" (map (fn [child-actx-bool]
+                      ["
" (vis-html-actx vis (first child-actx-bool)
+                                             actx-ch-ch-infos)
+                       "
"])
+                    children)
+        "
"]
+       [])
+     "
"]))

 (defn vis-svg-actx [vis actx actx-ch-ch-infos]
   ["<circle cx='"


Used actx-id variable.

Used actx-id variable.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -129,13 +129,12 @@
         children (:children actx-info)
         wait-chs (:wait-chs actx-info)
         chs (:chs vis)]
-    (assign-position positions (last actx))
-    ["
" (last actx)
+    (assign-position positions actx-id)
+    ["
" actx-id
      (if (not-empty wait-chs)
        [" -- waiting: ("
-        (map (fn [kv]
-               (let [[ch wait-kind] kv]
-                 [(:id (get chs ch)) wait-kind ", "]))
+        (map (fn [kv] (let [[ch wait-kind] kv]
+                        [(:id (get chs ch)) wait-kind ", "]))
              wait-chs)
         ")"]
        [])
@@ -160,10 +159,11 @@
      "
"]))

 (defn vis-svg-actx [vis actx positions actx-ch-ch-infos]
-  (let [chs (:chs vis)
+  (let [actx-id (last actx)
         actx-info (get-in vis [:actxs actx])
         children (:children actx-info)
-        wait-chs (:wait-chs actx-info)]
+        wait-chs (:wait-chs actx-info)
+        chs (:chs vis)]
     ["<circle cx='"
      (mod ((:last-id vis)) 500)
      "' cy='100' r='10'"


remove inspect

remove inspect

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -162,7 +162,7 @@
 (defn choose-frontend-id-seed [db document-id subs requested-remainder]
   (let [available-remainders (apply disj web-peer/remainders (map (comp :remainder :frontend-id-seed)
                                                                   (vals subs)))]
-    (if-let [remainder (if (contains? available-remainders (utils/inspect requested-remainder))
+    (if-let [remainder (if (contains? available-remainders requested-remainder)
                          requested-remainder
                          (first available-remainders ))]
       (let [used-client-parts (web-peer/client-parts-for-ns db document-id)


facts within deftests no longer seem to work in Clojure 1.8

--- test/implementation/line_numbers/fim_deftest.clj
+++ test/implementation/line_numbers/fim_deftest.clj
@@ -12,7 +12,7 @@
     (state/with-isolated-output-counters ; we only want the output
       (fact (+ 1 1) => 3))))

-(fact
+(future-fact "In clojure 1.8, a fact within `deftest` no longer gets the line number right"
   (let [test-result (ctf/run-tests [*ns*])]
     (:lines test-result) => (contains #"fim_deftest.clj:13")))


Fixed version number printing to catch all errors.

Also, will now print version number even if it is not of the form #.#.#

--- src/clojush.clj
+++ src/clojush.clj
@@ -2161,8 +2161,18 @@
     (reset! global-reuse-errors reuse-errors)
     (printf "\nStarting PushGP run.\n\n") (flush)
     (printf "Clojush version = ")
-    (printf (str (string/drop 1 (string/chop (re-find #"\"[0-9]+\.[0-9]+\.[0-9]+.*\""
-                                                 (first (string/split-lines (local-file/slurp* "project.clj")))))) "\n")) (flush)
+    (try
+      (let [version-number (string/drop 1 (string/chop
+                                            (re-find #"\".*\""
+                                                     (first (string/split-lines
+                                                              (local-file/slurp* "project.clj"))))))]
+        (if (empty? version-number)
+          (throw Exception)
+          (printf (str version-number "\n"))))
+      (flush)
+      (catch Exception e
+             (printf "version number unavailable\n")
+             (flush)))
     (print-params
       (error-function error-threshold population-size max-points atom-generators max-generations
                       mutation-probability mutation-max-points crossover-probability


Moved ago related stuff higher.

Moved ago related stuff higher.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -133,11 +133,11 @@
         gen-id #(swap! last-id inc)
         agw (make-ago-world nil)
         get-agw (fn [] agw)
-        step-ch (chan (dropping-buffer 1))
         event-ch (ago-chan agw)
         event-delay (atom init-event-delay)
         make-timeout-ch (fn [actx delay]
                           (ago-timeout ((:get-agw (actx-top actx))) delay))
+        step-ch (chan (dropping-buffer 1))
         render-ch (chan)
         w [{:gen-id gen-id
             :get-agw get-agw


Have wait-done at right level.

Have wait-done at right level.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -211,12 +211,12 @@
                    [server-addr port listen-result-ch])
              (when-let [[accept-ch close-accept-ch]
                         (atake server-init listen-result-ch)]
-               (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch)
+               (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch)))
            (reset! done true))
       (wait-done done)
       (prog-event world [:kv-server server-addr port]
                   #(update-in % [:servers server-addr]
-                              conj port)))))))
+                              conj port)))))

 (defn kv-client [client-addr server-addr server-port]
   (let [world (:world @prog-base)


formatting

formatting

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -191,7 +191,8 @@
                          :db/id #db/id [:entities]}])))

 (defn user-search-preferences
-  "Find the ids of users that have the a given value for a given key set in their preferences"
+  "Find the ids of users that have the a given value for a given key set in
+  their preferences"
   [conn k v]
   (d/q '[:find [?user-id ...]
          :in $ ?k ?v
@@ -235,7 +236,8 @@
                                  :thread/id thread-id
                                  :thread/group [:group/id group-id]}])))

-  (let [; for users subscribed to mentioned tags, open and subscribe them to the thread
+  (let [; for users subscribed to mentioned tags, open and subscribe them to
+        ; the thread
         txs-for-tag-mentions (mapcat
                                (fn [tag-id]
                                  (into
@@ -243,9 +245,11 @@
                                      :thread/tag [:tag/id tag-id]]]
                                    (mapcat (fn [user-id]
                                              [[:db/add [:user/id user-id]
-                                               :user/subscribed-thread [:thread/id thread-id]]
+                                               :user/subscribed-thread
+                                               [:thread/id thread-id]]
                                               [:db/add [:user/id user-id]
-                                               :user/open-thread [:thread/id thread-id]]])
+                                               :user/open-thread
+                                               [:thread/id thread-id]]])
                                            (get-users-subscribed-to-tag tag-id))))
                                mentioned-tag-ids)
         ; subscribe and open thread for users mentioned
@@ -254,9 +258,9 @@
                                   [[:db/add [:thread/id thread-id]
                                     :thread/mentioned [:user/id user-id]]
                                    [:db/add [:user/id user-id]
-                                    :user/subscribed-thread  [:thread/id thread-id]]
+                                    :user/subscribed-thread [:thread/id thread-id]]
                                    [:db/add [:user/id user-id]
-                                    :user/open-thread  [:thread/id thread-id]]])
+                                    :user/open-thread [:thread/id thread-id]]])
                                 mentioned-user-ids)
         ; open thread for users already subscribed to thread
         txs-for-tag-subscribers (map
@@ -272,13 +276,16 @@
                   :message/thread [:thread/id thread-id]
                   :message/created-at created-at}
         ; user who created message: show thread, subscribe to thread
-        subscribe-data [[:db/add [:user/id user-id] :user/open-thread [:thread/id thread-id]]
-                        [:db/add [:user/id user-id] :user/subscribed-thread [:thread/id thread-id]]]
-        {:keys [db-after tempids]} @(d/transact conn (concat [msg-data]
-                                                               subscribe-data
-                                                               txs-for-tag-subscribers
-                                                               txs-for-tag-mentions
-                                                               txs-for-user-mentions))]
+        subscribe-data [[:db/add [:user/id user-id]
+                         :user/open-thread [:thread/id thread-id]]
+                        [:db/add [:user/id user-id]
+                         :user/subscribed-thread [:thread/id thread-id]]]
+        {:keys [db-after tempids]} @(d/transact conn
+                                      (concat [msg-data]
+                                              subscribe-data
+                                              txs-for-tag-subscribers
+                                              txs-for-tag-mentions
+                                              txs-for-user-mentions))]
     (->> (d/resolve-tempid db-after tempids (msg-data :db/id))
          (d/pull db-after '[:message/id
                             :message/content


Humanize category names; modify transit response

--- src/clj/cglossa/db.clj
+++ src/clj/cglossa/db.clj
@@ -38,12 +38,13 @@
     ;; @rid is just a temporary key for the result object, so remove it
     (dissoc $ "@rid")
     ;; Transform values as needed
-    (walk/walk (fn [[k v]] [k (xform-val v)]) identity $)))
+    (walk/walk (fn [[k v]] [k (xform-val v)]) identity $)
+    (walk/keywordize-keys $)))

 (defn sql-query
   "Takes an SQL query and optionally a map of parameters, runs it against the
-  OrientDB database, and returns the query result as a seq. The params argument
-  is a hash map with the following optional keys:
+  OrientDB database, and returns the query result as a lazy seq of hash maps.
+  The params argument is a hash map with the following optional keys:

   * target or targets: A vertex ID, or a sequence of such IDs, to use as the target
   in the SQL query (e.g. '#12:1' or ['#12:1' '#12:2']), replacing the placeholder
@@ -85,11 +86,23 @@
          results    (.. graph (command cmd) (execute sql-params))]
      (map vertex->map results))))

+(defn- vertex-name [name code]
+  "Creates a human-friendly name from code unless name already exists."
+  (or name (-> code str/capitalize (str/replace "_" " "))))
+
 (defn get-corpus [code]
-  (let [res (sql-query (str "SELECT @rid as corpus_rid, name as corpus_name, "
-                            "$cats.@rid as cat_rids, $cats.name as cat_names "
-                            "FROM Corpus "
-                            "LET $cats = out('HasMetadataCategory') "
-                            "WHERE code = ?")
-                       {:sql-params [code]})]
-    (first res)))
+  (let [ress (sql-query (str "SELECT @rid as corpus_rid, name as corpus_name, "
+                             "$cats.@rid as cat_rids, $cats.code as cat_codes, "
+                             "$cats.name as cat_names "
+                             "FROM Corpus "
+                             "LET $cats = out('HasMetadataCategory') "
+                             "WHERE code = ?")
+                        {:sql-params [code]})
+        res  (as-> ress $
+                   (first $)
+                   (update $ :cat_names (partial map vertex-name) (:cat_codes $)))]
+    {:corpus              {:rid  (:corpus_rid res)
+                           :name (:corpus_name res)}
+     :metadata-categories (-> (map (fn [rid name] {:rid rid :name name})
+                                   (:cat_rids res)
+                                   (:cat_names res)))}))


Installed card hosting

Installed card hosting

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -661,7 +661,8 @@
    {:effect (effect (draw 3))}

    "Dinosaurus"
-   {:abilities [{:req (req (empty? (:hosted card))) :cost [:click 1]
+   {:abilities [{:label "Install a non-AI icebreaker on Dinosaurus"
+                 :req (req (empty? (:hosted card))) :cost [:click 1]
                  :prompt "Choose a non-AI icebreaker to install on Dinosaurus"
                  :choices (req (filter #(and (has? % :subtype "Icebreaker")
                                              (not (has? % :subtype "AI")))
@@ -669,7 +670,14 @@
                  :msg (msg "host " (:title target))
                  :effect (effect (gain :memory (:memoryunits target))
                                  (runner-install target {:host-card card})
-                                 (update-breaker-strength target))}]
+                                 (update-breaker-strength target))}
+                {:label "Host an installed non-AI icebreaker on Dinosaurus"
+                 :req (req (empty? (:hosted card)))
+                 :prompt "Choose a program to host on Leprechaun"
+                 :choices {:req #(and (has? % :subtype "Icebreaker")
+                                      (not (has? % :subtype "AI"))
+                                      (:installed %))}
+                 :msg (msg "host " (:title target)) :effect (effect (host card target))}]
     :events {:pre-breaker-strength {:req (req (= (:cid target) (:cid (first (:hosted card)))))
                                     :effect (effect (breaker-strength-bonus 2))}}}

@@ -691,9 +699,15 @@
                                              (not (has? % :subtype "Icebreaker"))
                                              (<= (:cost %) (:credit runner)))
                                        (:hand runner)))
-                 :msg (msg "host " (:title target))
+                 :msg (msg "install and host" (:title target))
                  :effect (effect (gain :memory (:memoryunits target))
-                                 (runner-install target {:host-card card}))}]}
+                                 (runner-install target {:host-card card}))}
+                {:label "Host an installed non-Icebreaker program on Djinn"
+                 :prompt "Choose an installed non-Icebreaker program to host on Djinn"
+                 :choices {:req #(and (= (:type %) "Program")
+                                      (not (has? % :subtype "Icebreaker"))
+                                      (:installed %))}
+                 :msg (msg "host " (:title target)) :effect (effect (host card target))}]}

    "Director Haas"
    {:effect (effect (gain :click 1 :click-per-turn 1)) :leave-play (effect (lose :click-per-turn 1))
@@ -1403,14 +1417,20 @@
                  :msg "expose 1 card"}]}

    "Leprechaun"
-   {:abilities [{:req (req (<= (count (:hosted card)) 2)) :cost [:click 1]
+   {:abilities [{:label "Install a program on Leprechaun"
+                 :req (req (<= (count (:hosted card)) 2)) :cost [:click 1]
                  :prompt "Choose a program to install on Leprechaun"
                  :choices (req (filter #(and (= (:type %) "Program")
                                              (<= (:cost %) (:credit runner)))
                                        (:hand runner)))
                  :msg (msg "host " (:title target))
                  :effect (effect (gain :memory (:memoryunits target))
-                                 (runner-install target {:host-card card}))}]}
+                                 (runner-install target {:host-card card}))}
+                {:label "Host an installed program on Leprechaun"
+                 :req (req (<= (count (:hosted card)) 2))
+                 :prompt "Choose a program to host on Leprechaun"
+                 :choices {:req #(and (= (:type %) "Program") (:installed %))}
+                 :msg (msg "host " (:title target)) :effect (effect (host card target))}]}

    "Leverage"
    {:player :corp
@@ -1715,16 +1735,22 @@
                                           (if (>= (:advance-counter (get-card state card)) 5) 3 2)))}}}

    "Off-Campus Apartment"
-   {:abilities [{:prompt "Choose a connection to install on Off-Campus Apartment"
+   {:abilities [{:label "Install and host a connection on Off-Campus Apartment"
+                 :prompt "Choose a connection to install on Off-Campus Apartment"
                  :choices (req (filter #(and (has? % :subtype "Connection")
                                              (<= (:cost %) (:credit runner)))
                                        (:hand runner)))
                  :msg (msg "host " (:title target) " and draw 1 card")
-                 :effect (effect (runner-install target {:host-card card}) (draw))}]}
+                 :effect (effect (runner-install target {:host-card card}) (draw))}
+                {:label "Host an installed connection"
+                 :prompt "Choose a connection to host on Off-Campus Apartment"
+                 :choices {:req #(and (has? % :subtype "Connection") (:installed %))}
+                 :msg (msg "host " (:title target) " and draw 1 card")
+                 :effect (effect (host card target) (draw))}]}

    "Omni-Drive"
    {:recurring 1
-    :abilities [{:label "Install a program of 1[Memory Unit] or less on Omni-Drive"
+    :abilities [{:label "Install and host a program of 1[Memory Unit] or less on Omni-Drive"
                  :req (req (empty? (:hosted card))) :cost [:click 1]
                  :prompt "Choose a program of 1[Memory Unit] or less to install on Omni-Drive"
                  :choices (req (filter #(and (= (:type %) "Program")
@@ -1733,7 +1759,11 @@
                                        (:hand runner)))
                  :msg (msg "host " (:title target))
                  :effect (effect (gain :memory (:memoryunits target))
-                                 (runner-install target {:host-card card}))}]}
+                                 (runner-install target {:host-card card}))}
+                {:label "Host an installed program of 1[Memory Unit] or less on Omni-Drive"
+                 :prompt "Choose an installed program of 1[Memory Unit] or less to host on Omni-Drive"
+                 :choices {:req #(and (= (:type %) "Program") (:installed %))}
+                 :msg (msg "host " (:title target)) :effect (effect (host card target))}]}

    "Oracle May"
    {:abilities [{:cost [:click 1] :once :per-turn :prompt "Choose card type"
@@ -1894,7 +1924,8 @@
                           :bad-publicity (Integer/parseInt target)))}

    "Progenitor"
-   {:abilities [{:cost [:click 1] :req (req (empty? (:hosted card)))
+   {:abilities [{:label "Install a virus program on Progenitor"
+                 :cost [:click 1] :req (req (empty? (:hosted card)))
                  :prompt "Choose a Virus program to install on Progenitor"
                  :choices (req (filter #(and (= (:type %) "Program")
                                              (has? % :subtype "Virus")
@@ -1902,7 +1933,13 @@
                                        (:hand runner)))
                  :msg (msg "host " (:title target))
                  :effect (effect (gain :memory (:memoryunits target))
-                                 (runner-install target {:host-card card}))}]
+                                 (runner-install target {:host-card card}))}
+                {:label "Host an installed virus on Progenitor" :req (req (empty? (:hosted card)))
+                 :prompt "Choose an installed virus program to host on Progenitor"
+                 :choices {:req #(and (= (:type %) "Program")
+                                      (has? % :subtype "Virus")
+                                      (:installed %))}
+                 :msg (msg "host " (:title target)) :effect (effect (host card target))}]
     :events {:purge {:effect (req (when-let [c (first (:hosted card))]
                                     (add-prop state side c :counter 1)))}}}

@@ -2263,13 +2300,19 @@
     :events {:pre-install nil}}

    "Scheherazade"
-   {:abilities [{:cost [:click 1] :prompt "Choose a program to install on Scheherazade"
+   {:abilities [{:label "Install and host a program from Grip"
+                 :cost [:click 1] :prompt "Choose a program to install on Scheherazade"
                  :choices (req (filter #(and (has? % :type "Program")
                                              (<= (:cost %) (:credit runner))
                                              (<= (:memoryunits %) (:memory runner)))
                                        (:hand runner)))
                  :msg (msg "host " (:title target) " and gain 1 [Credits]")
-                 :effect (effect (runner-install target {:host-card card}) (gain :credit 1))}]}
+                 :effect (effect (runner-install target {:host-card card}) (gain :credit 1))}
+                {:label "Host an installed program"
+                 :prompt "Choose a program to host on Scheherazade"
+                 :choices {:req #(and (= (:type %) "Program") (:installed %))}
+                 :msg (msg "host " (:title target) " and gain 1 [Credits]")
+                 :effect (effect (host card target) (gain :credit 1))}]}

    "Scorched Earth"
    {:req (req tagged) :effect (effect (damage :meat 4 {:card card}))}


comment update about #2 [ci skip]

comment update about #2 [ci skip]

--- src/clygments/core.clj
+++ src/clygments/core.clj
@@ -78,7 +78,8 @@
           (do
             (.exec python (str "_res=highlight(\"\"\"" (escape-string code)
                                "\"\"\",_r,_f)\n"))
-            ;; FIXME it won't work with non-text formatters, such as gif (#2)
+            ;; This won't work with non-text formatters, such as gif, but it's
+            ;; ok since they're not supported on Jython (#2)
             (.get python "_res" String))))
       (catch Exception e
         (.printStackTrace e)


fixes https://github.com/status-im/status-react/issues/961

--- src/status_im/chat/views/message.cljs
+++ src/status_im/chat/views/message.cljs
@@ -307,15 +307,25 @@
                            photo-path)}
            :style  st/photo}]])

+(defview my-photo [from]
+  [account [:get-current-account]]
+  (let [{:keys [photo-path]} account]
+    [view st/photo-view
+     [image {:source {:uri (if (str/blank? photo-path)
+                             (identicon from)
+                             photo-path)}
+             :style  st/photo}]]))
+
 (defn message-body
-  [{:keys [last-outgoing? message-type same-author from index] :as message} content]
+  [{:keys [last-outgoing? message-type same-author from index outgoing] :as message} content]
   (let [delivery-status :seen-by-everyone]
     [view st/group-message-wrapper
      [view (st/message-body message)
       [view st/message-author
-       (when (and (or (= index 1) (not same-author))
-                  (not= from "me"))
-         [member-photo from])]
+       (when (or (= index 1) (not same-author))
+         (if outgoing
+           [my-photo from]
+           [member-photo from]))]
       [view (st/group-message-view message)
        content
        (when last-outgoing?


Code reloading works now

Code reloading works now

--- src/webapp/framework/client/main.cljs
+++ src/webapp/framework/client/main.cljs
@@ -1,37 +1,39 @@
 (ns webapp.framework.client.main
   (:require
     [figwheel.client :as fw]
-   [goog.net.cookies :as cookie]
-   [om.core          :as om :include-macros true]
-   [om.dom           :as dom :include-macros true]
-   [cljs.core.async  :refer [put! chan <! pub timeout]]
-   [om-sync.core     :as async]
-   [clojure.data     :as data]
-   [clojure.string   :as string]
-   [ankha.core       :as ankha]
-   [webapp.framework.client.protocols]
-   [webapp.framework.client.records]
-  )
+    [goog.net.cookies :as cookie]
+    [om.core          :as om :include-macros true]
+    [om.dom           :as dom :include-macros true]
+    [cljs.core.async  :refer [put! chan <! pub timeout]]
+    [om-sync.core     :as async]
+    [clojure.data     :as data]
+    [clojure.string   :as string]
+    [ankha.core       :as ankha]
+    [webapp.framework.client.protocols]
+    [webapp.framework.client.records]
+    )

   (:use
-   [webapp.framework.client.coreclient      :only  [log remote-fn neo4j-fn]]
-   [webapp.framework.client.system-globals  :only  [app-state
-                                                    playback-controls-state
-                                                    reset-app-state
-                                                    playbackmode
-                                                    start-component
-                                                    init-fn
-                                                    data-state
-                                                    app-watch-on?
-                                                    record-ui]]
-   [webapp.framework.client.components.system-container :only  [main-view]]
-   [webapp.framework.client.components.playback  :only  [playback-controls-view ]]
-   )
+    [webapp.framework.client.coreclient      :only  [remote-fn neo4j-fn]]
+    [webapp.framework.client.system-globals  :only  [app-state
+                                                     playback-controls-state
+                                                     reset-app-state
+                                                     playbackmode
+                                                     start-component
+                                                     init-fn
+                                                     data-state
+                                                     app-watch-on?
+                                                     record-ui
+                                                     touch
+                                                     ]]
+    [webapp.framework.client.components.system-container :only  [main-view]]
+    [webapp.framework.client.components.playback  :only  [playback-controls-view ]]
+    )
   (:use-macros
-   [webapp.framework.client.coreclient :only  [ns-coils remote neo4j]]
-   )
+    [webapp.framework.client.coreclient :only  [ns-coils remote neo4j log]]
+    )
   (:require-macros
-   [cljs.core.async.macros :refer [go]]))
+    [cljs.core.async.macros :refer [go]]))


Put realtime log processing into a function

Put realtime log processing into a function

--- src/webapp/framework/client/main.cljs
+++ src/webapp/framework/client/main.cljs
@@ -143,14 +143,6 @@

-;--------------------------------------------------------
-(defn ^:export load_debug [setup-config]
-;--------------------------------------------------------
-  (reset!  start-component  (get setup-config :start-component))
-  (reset!  init-fn          (get setup-config :setup-fn))
-  (debug))
-
-

 (fw/start { :on-jsload (fn []


Updates to mirror improving performance

Updates to mirror improving performance

--- spectacles/src/spectacles/mirror_camera.clj
+++ spectacles/src/spectacles/mirror_camera.clj
@@ -11,7 +11,7 @@
                      :width 1280
                      :height 720
                      :frame-rate 30})
-  (def cell-size 15)
+  (def cell-size 20)
   (def cols (/ (:width camera-specs) cell-size))
   (def rows (/ (:height camera-specs) cell-size))
   (q/color-mode :rgb 255 255 255 100)
@@ -31,27 +31,24 @@
   )

 (defn update [state]
-  state)
-
-(defn draw [state]
   (if (.available (:camera state))
     (do
       (.read (:camera state))
       (.loadPixels (:camera state))
-      (q/background 2 89 15)
-      (doseq [i (range cols)
-              j (range rows)]
+      (assoc state :pixels (.pixels (:camera state))))
+    state))

-        (let [x (* i cell-size)
-              y (* j cell-size)
-              pixels (.pixels (:camera state))
-              location (+ (- (:width camera-specs) x 1) (* (:width camera-specs) y))
-              color (nth pixels location)
-              size (* (/ (q/brightness color) 255) cell-size)
-              ]
-          (q/ellipse  (+ x (/ cell-size 2)) (+ y (/ cell-size 2)) size size)
-          )
-        )
-      )
-    )
-  )
+(defn draw [state]
+  (q/background 2 89 15)
+  (doseq [i (range cols)
+          j (range rows)]
+    (let [x (* i cell-size)
+          y (* j cell-size)
+          pixels (:pixels state)
+          location (+ (- (:width camera-specs) x 1) (* (:width camera-specs) y))
+          color (nth pixels location)
+          size (* (/ (q/brightness color) 255) cell-size)
+          ]
+      (q/ellipse  (+ x (/ cell-size 2)) (+ y (/ cell-size 2)) size size))))
+
+


Comment about util

Comment about util

--- src/cylon/util.clj
+++ src/cylon/util.clj
@@ -1,3 +1,4 @@
+;; For internal Cylon use only. Not part of a published API. Do not use.
 (ns cylon.util
   (:require
    [schema.core :as s])


Removed docstring from internal macro

Removed docstring from internal macro

--- src/compojure/core.clj
+++ src/compojure/core.clj
@@ -57,11 +57,7 @@
           (throw (Exception. (str "Unexpected binding: " sym))))
       (mapcat identity binds))))

-(defmacro bind-request
-  "Bind a request to a collection of symbols. The collection can be a Clojure
-  map destructuring binding for the request map, or it can be a vector of
-  parameter bindings."
-  [request bindings & body]
+(defmacro bind-request [request bindings & body]
   (if (vector? bindings)
     `(let [~@(vector-bindings bindings request)] ~@body)
     `(let [~bindings ~request] ~@body)))


reset keyboard when losing visibility

reset keyboard when losing visibility

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -1257,6 +1257,14 @@
      (when unread-chats?
        (favicon/set-unread!)))))

+(defmethod control-event :visibility-changed
+  [browser-state message {:keys [hidden?]} state]
+  (if hidden?
+    ;; reset key state when losing visibility, prevents
+    ;; shortcuts from getting stuck
+    (dissoc state :keyboard)
+    state))
+
 (defmethod post-control-event! :visibility-changed
   [browser-state message {:keys [hidden?]} previous-state current-state]
   (when (and (not hidden?)


Fix output in main.

Fix output in main.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -61,6 +61,7 @@
     :default "no-op"]])

 (defn -main [& args]
+  (println "Starting dsbdp main...")
   (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
     (when (:help options)
       (println summary)
@@ -105,7 +106,7 @@
                       (fn []
                         (.inc in-cntr))))
           thread-info-fn (create-thread-info-fn)]
-      (println "Starting dsbdp main...")
+      (println "Starting experiment...")
       (.setName (Thread/currentThread) "Main")
       (.start in-loop)
       (run-repeat (executor) (fn []


Further experiments and clean up.

Further experiments and clean up.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -8,7 +8,7 @@

 (ns
   ^{:author "Ruediger Gad",
-    :doc "Main class for launching experiments"}
+    :doc "Main class for launching experiments"}
   dsbdp.main
   (:use
     clj-assorted-utils.util
@@ -34,7 +34,7 @@
                  (.inc out-cntr))
         in-data 1
         pipeline (create-local-processing-pipeline
-                   (create-hashmap-inc-put-proc-fns 4)
+                   (create-hashmap-inc-put-proc-fns 6)
                    out-fn)
         in-fn (get-in-fn pipeline)
         in-loop (ProcessingLoop.


Upgrade to latest bidi

Upgrade to latest bidi

--- modules/bidi/project.clj
+++ modules/bidi/project.clj
@@ -1,12 +1,12 @@
 ;; Copyright © 2014 JUXT LTD.

-(defproject juxt.modular/bidi "0.9.3"
+(defproject juxt.modular/bidi "0.9.4"
   :description "A modular extension that provides support for bidi routing"
   :url "https://github.com/juxt/modular/tree/master/modules/bidi"
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}
   :dependencies [[com.stuartsierra/component "0.2.3"]
-                 [bidi "1.19.1"]
+                 [bidi "1.20.0"]
                  [juxt.modular/ring "0.5.3"]
                  [prismatic/schema "0.4.2"]]
   :profiles {:dev


CMR-2112 Collection search and validation code

--- system-int-test/test/cmr/system_int_test/ingest/ops_collections_translation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/ops_collections_translation_test.clj
@@ -1,27 +1,19 @@
 (ns cmr.system-int-test.ingest.ops-collections-translation-test
   "Translate OPS collections into various supported metadata formats."
-  (:require
-    [clj-http.client :as client]
-    [clojure.string :as str]
-    [clojure.test :refer :all]
-    [cmr.common.concepts :as concepts]
-    [cmr.common.log :refer [error info]]
-    [cmr.common.mime-types :as mt]
-    [cmr.common.xml :as cx]
-    [cmr.system-int-test.system :as s]
-    [cmr.system-int-test.utils.fast-xml :as fx]
-    [cmr.system-int-test.utils.ingest-util :as ingest]
-    [cmr.system-int-test.utils.search-util :as search]
-    [cmr.system-int-test.utils.url-helper :as url]
-    [cmr.umm-spec.json-schema :as json-schema]
-    [cmr.umm-spec.test.location-keywords-helper :as lkt]
-    [cmr.umm-spec.umm-json :as umm-json]
-    [cmr.umm-spec.umm-spec-core :as umm]
-    [cmr.umm-spec.validation.umm-spec-validation-core :as umm-validation]))
+  (:require [clojure.test :refer :all]
+            [clj-http.client :as client]
+            [cmr.common.xml :as cx]
+            [cmr.system-int-test.utils.fast-xml :as fx]
+            [clojure.string :as str]
+            [cmr.common.log :refer [error info]]
+            [cmr.common.mime-types :as mt]
+            [cmr.system-int-test.utils.ingest-util :as ingest]
+            [cmr.system-int-test.utils.search-util :as search]
+            [cmr.system-int-test.utils.url-helper :as url]
+            [cmr.system-int-test.system :as s]
+            [cmr.umm-spec.umm-spec-core :as umm]))

 (use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1"}))
-
-(def context (lkt/setup-context-for-test lkt/sample-keyword-map))

 (def starting-page-num
   "The starting page-num to retrieve collections for the translation test."
@@ -72,7 +64,7 @@
     "C1214604063-SCIOPS" ;;Line 291 - cvc-datatype-valid.1.2.1: '<http://pubs.usgs.gov/of/2014/1040/data/undersea_features.zip>' is not a valid value for 'anyURI'.
     "C1214595389-SCIOPS" ;;Line 108 - cvc-datatype-valid.1.2.1: 'IPY  http://ipy.antarcticanz.govt.nz/projects/southern-victoria-land-geology/' is not a valid value for 'anyURI'.
     "C1214608487-SCIOPS" ;;Line 303 - cvc-datatype-valid.1.2.1: 'Scanned images: http://atlas.gc.ca/site/english/maps/archives' is not a valid value for 'anyURI'.
-    "C1214603723-SCIOPS"}) ;;Line 132 - cvc-datatype-valid.1.2.1: '<http://sofia.usgs.gov/projects/workplans12/jem.html>' is not a valid value for 'anyURI'.
+    "C1214603723-SCIOPS" ;;Line 132 - cvc-datatype-valid.1.2.1: '<http://sofia.usgs.gov/projects/workplans12/jem.html>' is not a valid value for 'anyURI'.

     ;; The following collections failed ingest validation, but not xml schema validation.
     ;; I have changed the validation from ingest validation to xml validation, so we don't
@@ -99,7 +91,7 @@
     ; "C5862870-LARC_ASDC"
     ; "C5784310-LARC_ASDC"

-
+    })

 (def valid-formats
   "Valid metadata formats that is supported by CMR."
@@ -144,40 +136,6 @@
                 (format "Failed xml schema validation when translating %s to %s for collection %s. %s"
                         (name metadata-format) (name output-format) concept-id validation-errs))))))))

-
-(defn- translate-record-to-umm
-  "Translate collection from native format to UMM-C"
-  [record]
-  (let [{:keys [metadata-format metadata concept-id]} record]
-    (umm/parse-metadata context :collection metadata-format metadata {:apply-default? true})))
-
-(defn- get-collection-validation-errors
-  "Perform the following collection validations:
-   * Validate metadata against the XML schema
-   * Validation the UMM collection record against the current UMM JSON schema
-   * Valiadte the UMM collection against UMM collection rules
-  Return a list of validation errors."
-  [record]
-  (remove empty?
-   (concat
-     (umm/validate-xml :collection (:metadata-format record) (:metadata record))
-     (json-schema/validate-umm-json (umm-json/umm->json (:collection record)) :collection)
-     (umm-validation/validate-collection record))))
-
-(defn- translate-and-validation-collection
-  "For a search result record, translate the metadata to UMM, validate the metadata and UMM record
-  and return a validation result record including the concept id, provider id, entry title, and
-  all validation errors for the record."
-  [record]
-  (let [record (assoc record :collection (translate-record-to-umm record))
-        validation-errors (get-collection-validation-errors record)
-        concept-id (:concept-id record)]
-    (when (seq validation-errors)
-      {:concept-id concept-id
-       :provider-id (:provider-id (concepts/parse-concept-id concept-id))
-       :entry-title (get-in record [:collection :EntryTitle])
-       :errors validation-errors})))
-
 (defn get-collections
   "Returns the collections as a list of maps with concept-id, revision-id, metadata-format and metadata."
   [page-size page-num]
@@ -200,44 +158,16 @@
            (cx/elements-at-path parsed [:result])
            metadatas))))

-(defn- get-ops-collections-umm-validation-errors
-  "Loops through the collections in ops with a paged search. For each collection, validate the
-  metadata against the XML schema, validate the collection translated to UMM against the current
-  UMM JSON schema, and validate the UMM collection against the validation rules.
-  Return a list of all validation errors across all collections."
-  []
-  (loop [page-num starting-page-num results []]
-    (let [collections (get-collections search-page-size page-num)
-          error-results (map translate-and-validation-collection collections)
-          all-results (concat results (remove nil? error-results))]
-      (if (and (>= (count collections) search-page-size))
-        (recur (+ page-num 1) all-results)
-        all-results))))
-
-(defn- get-ops-collections-umm-validation-errors-debug
-  []
-  (let [colls (get-collections search-page-size 1)
-        error-results (map translate-and-validation-collection colls)
-        all-results (remove nil? error-results)]
-    (if (and (>= (count colls) search-page-size) (<= 200 (count colls)))
-      all-results
-      all-results)))
-
 ;; Comment out this test so that it will not be run as part of the build.
-#_(deftest ops-collections-translation
-   (testing "Translate OPS collections into various supported metadata formats and make sure they pass validation."
-     (loop [page-num starting-page-num]
-       (let [colls (get-collections search-page-size page-num)]
-         (info "Translating collections on page-num: " page-num)
-         (doseq [coll colls]
-           (verify-translation-via-schema-validation coll))
-         ;; We will turn on ingest validation later when ingest is backed by umm-spec-lib
-         ; (verify-translation-via-ingest-validation coll))
-         (when (>= (count colls) search-page-size)
-           (recur (+ page-num 1)))))
-     (info "Finished OPS collections translation.")))
-
-(deftest ops-collections-validation
-   (testing "get-collections the current collections in ops against the current UMM schema"
-     (def results (get-ops-collections-umm-validation-errors-debug))
-    (info "Finished OPS collections translation.")))
+#_(deftest ops-collections-translation)
+  (testing "Translate OPS collections into various supported metadata formats and make sure they pass validation."
+    (loop [page-num starting-page-num]
+      (let [colls (get-collections search-page-size page-num)]
+        (info "Translating collections on page-num: " page-num)
+        (doseq [coll colls]
+          (verify-translation-via-schema-validation coll))
+        ;; We will turn on ingest validation later when ingest is backed by umm-spec-lib
+        ; (verify-translation-via-ingest-validation coll))
+        (when (>= (count colls) search-page-size)
+          (recur (+ page-num 1)))))
+    (info "Finished OPS collections translation."))


Add missing .content div

Add missing .content div

--- src/braid/client/ui/views/pages/recent.cljs
+++ src/braid/client/ui/views/pages/recent.cljs
@@ -23,6 +23,7 @@
                  reverse)]
         [:div.page.recent
          (if (and (not (@page :loading?)) (empty? sorted-threads))
-           [:p "No recent threads in this group"]
+           [:div.content
+            [:p "No recent threads in this group"]]
            [threads-view {:threads sorted-threads}])]))))


convert discoverable by to a list (#720)

convert discoverableByGroups to a vector

--- src/cljs/main/broadfcui/page/workspace/summary/catalog/wizard.cljs
+++ src/cljs/main/broadfcui/page/workspace/summary/catalog/wizard.cljs
@@ -9,8 +9,8 @@
     [broadfcui.endpoints :as endpoints]
     [broadfcui.page.workspace.summary.catalog.questions :refer [Questions]]
     [broadfcui.page.workspace.summary.library-utils :as library-utils]
-    [broadfcui.utils :as utils]
-    ))
+    [broadfcui.utils :as utils]))
+

 (defn- render-wizard-breadcrumbs [{:keys [library-schema page-num pages-seen]}]
   (let [pages (:wizard library-schema)]
@@ -25,13 +25,13 @@
                          :fontWeight (when this "bold")
                          :color (when-not (or this (contains? pages-seen index)) (:text-lighter style/colors))}}
             title])) pages)]
-      [:div {:style {:paddingBottom "0.5rem"
-                     :color (when-not (contains? pages-seen (count pages)) (:text-lighter style/colors))
-                     :fontWeight (when (= page-num (count pages)) "bold")}}
-       "Discoverability"]
-      [:div {:style {:color (when-not (contains? pages-seen (+ 1 (count pages))) (:text-lighter style/colors))
-                     :fontWeight (when (> page-num (count pages)) "bold")}}
-       "Summary"]]))
+     [:div {:style {:paddingBottom "0.5rem"
+                    :color (when-not (contains? pages-seen (count pages)) (:text-lighter style/colors))
+                    :fontWeight (when (= page-num (count pages)) "bold")}}
+      "Discoverability"]
+     [:div {:style {:color (when-not (contains? pages-seen (+ 1 (count pages))) (:text-lighter style/colors))
+                    :fontWeight (when (> page-num (count pages)) "bold")}}
+      "Summary"]]))

 (defn- find-required-attributes [library-schema]
   (->> (map :required (:oneOf library-schema))
@@ -60,23 +60,29 @@

 (def ^:private ALL_USERS "All users")

+(defn- ensure-sequence [input]
+  ;;input may or maynot be a sequence, make it a sequence
+  (cond (sequential? input) input
+        (nil? input) []
+        :else [input]))
+
 (react/defc DiscoverabilityPage
   {:validate (constantly nil)
    :get-initial-state
    (fn [{:keys [props]}]
-     (select-keys props [:library:discoverableByGroups :owner?]))
+     {:library:discoverableByGroups (ensure-sequence (:library:discoverableByGroups props))})
    :get-attributes
    (fn [{:keys [state]}]
-     (if (nil? (:library:discoverableByGroups @state)) {} (select-keys @state [:library:discoverableByGroups])))
+     (select-keys @state [:library:discoverableByGroups]))
    :set-groups
    (fn [{:keys [state]} new-val]
-     (swap! state assoc :library:discoverableByGroups (if (= new-val ALL_USERS) nil new-val)))
+     (swap! state assoc :library:discoverableByGroups (if (= new-val ALL_USERS) [] [new-val])))
    :render
    (fn [{:keys [state props this]}]
      (let [{:keys [library:discoverableByGroups]} @state
            {:keys [:owner? :curator?]} props
            editable? (and curator? owner?)
-           selected (if (empty? library:discoverableByGroups) ALL_USERS library:discoverableByGroups)]
+           selected (if (empty? library:discoverableByGroups) ALL_USERS (first library:discoverableByGroups))]
        [:div {} "Dataset should be discoverable by:"
         (style/create-identity-select {:value selected
                                        :display "flex" :alignItems "center"
@@ -97,7 +103,7 @@
                     :padding "1rem"}}
       [:div {:style {:paddingBottom "0.5rem" :marginBottom "0.5rem"
                      :borderBottom (str "1px solid " (:exception-state style/colors))}}
-       "The following additional attributes are required to publish:" ]
+       "The following additional attributes are required to publish:"]
       [:div {:style {:fontSize 14}}
        (map (fn [attribute]
               [:div {:style {:paddingBottom "0.2rem"}} (get-in library-schema [:properties (keyword attribute) :title])])
@@ -112,9 +118,9 @@
      (if (= (:library:useLimitationOption attributes) "orsp") ;; TODO: change this so not hardcoded
        (library-utils/render-property library-schema attributes :library:orsp)
        (library-utils/render-consent-codes library-schema attributes))
-     (library-utils/render-library-row "Discoverability" (if-let [group (:library:discoverableByGroups attributes)] group ALL_USERS))])])
-
-
+     (library-utils/render-library-row "Discoverability"
+                                       (let [groups (get attributes :library:discoverableByGroups [])]
+                                         (if (empty? groups) ALL_USERS (first groups))))])])

 (defn- get-initial-attributes [workspace]
   (utils/map-values


Validate!

Validate!

--- src/icecap/api.clj
+++ src/icecap/api.clj
@@ -13,6 +13,7 @@
 (defn create-cap
   "Creates a capability."
   [plan & {store :store kdf :kdf scheme :scheme}]
+  (validate-plan plan)
   (let [cap (crypto/make-cap)
         {index :index cap-key :cap-key} (crypto/derive kdf cap)
         encoded-plan (nippy/freeze plan)


add boot up comment

add boot up comment

--- ohack/src/ohack/core.clj
+++ ohack/src/ohack/core.clj
@@ -3,3 +3,11 @@
         [overtone.inst.piano]
         [overtone.inst.sampled-piano])
   (:require [overtone.inst.synth :as synth]))
+
+;; run M-x cider-jack-in to get started
+;;
+;; once started, move your cursor to the (ns ...) block above and hit
+;; C-M-x to evaluate it and boot the supercollider server.  if your
+;; sampled-piano samples are not cached, overtime will attempt to
+;; download them and cache them now. once you see the prompt update with
+;; the Overtone logo, you are good to go.


Removed unused function added by merge

Removed unused function added by merge

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -294,12 +294,6 @@
         {:expound/keys [form in]} problem
         type (:expound.spec.problem/type problem)]
     (value-str type spec-name form in problems opts)))
-
-(defn ^:private problem-group-str* [spec-name problems opts]
-  (let [problem (first problems)
-        {:expound/keys [form in]} problem
-        type (:expound.spec.problem/type problem)]
-    (problem-group-str type spec-name form in problems opts)))

 ;; a path may be converted into something we can use and find the inner value
 ;; or it may not, and so value-in WON'T be able to handle it, because


use the new template, add a placeholder /logout route

--- src/aspire/web.clj
+++ src/aspire/web.clj
@@ -29,10 +29,13 @@
 (defresource resource-base
   :available-media-types ["text/html"]
   :handle-ok (fn [_]
-               (a-tpl/render (a-tpl/base (rand-int 100) "http://google.com" "Bo Jackson"))))
+               (a-tpl/render (a-tpl/base (rand-int 100) "http://google.com" "Bo Jackson"
+                                         "Welcome to VLACS! (make me configurable)" "Check out our learning options below. You'll find projects, courses, and opportunities to learn by pursuing your interests. Join us in your learning adventure! Actually, this text needs to be configured by the admin in some reasonable kind of interface."
+                                         ["Actually, these steps should be configured by the admin in some reasonable kind of interface." "Maybe there will be a step here." "Possibly another step?"]))))

 (defroutes app-routes
-  (ANY "/" [] resource-base))
+  (ANY "/" [] resource-base)
+  (ANY "/logout" [] "Nothing here yet but us chickens."))

 (def app
   (-> app-routes


Don't need so much nesting.

Don't need so much nesting.

--- src/cbfg/fence.clj
+++ src/cbfg/fence.clj
@@ -35,19 +35,17 @@
                                (recur (conj receiving ((:rq v)))
                                       (if (:fence v) ch nil)
                                       nil))
-        :else (if (= v nil)
-                (let [new-receiving (disj receiving ch)]
-                  (if (empty? new-receiving)
-                    (do (if fenced-value
-                          (>! output-channel fenced-value))
-                        (recur new-receiving nil nil))
-                    (recur new-receiving fenced-on fenced-value)))
-               (if (= ch fenced-on)
-                 (do (if fenced-value
-                       (>! output-channel fenced-value))
-                     (recur receiving fenced-on v))
-                 (do (>! output-channel v)
-                     (recur receiving fenced-on fenced-value)))))))
+        (= v nil) (let [new-receiving (disj receiving ch)]
+                    (if (empty? new-receiving)
+                      (do (if fenced-value
+                            (>! output-channel fenced-value))
+                          (recur new-receiving nil nil))
+                      (recur new-receiving fenced-on fenced-value)))
+        (= ch fenced-on) (do (if fenced-value
+                               (>! output-channel fenced-value))
+                             (recur receiving fenced-on v))
+        :else (do (>! output-channel v)
+                  (recur receiving fenced-on fenced-value)))))
     {:in input-channel
      :out output-channel}))


Proxy to preserve cookie structure

Proxy to preserve cookie structure

--- src/frontend/proxy.clj
+++ src/frontend/proxy.clj
@@ -25,9 +25,13 @@
    :headers {"Content-Type" "text/plain"}
    :body (str "Cannot access backend\n" error)})

+(defn strip-secure-cookie [header-val]
+  (cond (string? header-val) (string/replace header-val "Secure;" "")
+        (coll? header-val) (map strip-secure-cookie header-val)))
+
 (defn strip-secure [headers]
   (if (headers "set-cookie")
-    (update-in headers ["set-cookie"] clojure.string/replace "Secure;" "")
+    (update-in headers ["set-cookie"] strip-secure-cookie)
     headers))

 (defn rewrite-success


CMR-1397: Fixed header name in get-search-results-format

--- search-app/src/cmr/search/api/routes.clj
+++ search-app/src/cmr/search/api/routes.clj
@@ -132,7 +132,7 @@
    (mt/mime-type->format
      (or (path-w-extension->mime-type path-w-extension valid-mime-types)
          (mt/extract-header-mime-type valid-mime-types headers "accept" true)
-         (mt/extract-header-mime-type valid-mime-types headers "concept-type" false))
+         (mt/extract-header-mime-type valid-mime-types headers "content-type" false))
      default-mime-type)))

 (defn process-params


Suppress inputs while animating

Suppress inputs while animating

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -153,14 +153,18 @@
 (defn projectors-for-state [state]
   (if (= (:projection state) :fisheye) fisheye-projectors zoom-out-projectors))

-(defn sync-graph! [state & {:keys [animate]}]
+(defn sync-graph! [state & {:keys [animation-signaller]}]
   (let [{:keys [svg nodes links camera-pos view-size]} state
         {:keys [project-displacement
                 project-radius
                 project-opacity]} (projectors-for-state state)
-        maybe-transition (if animate
-                           #(-> % .transition (.duration 500))
-                           identity)
+        transition (fn [selection]
+                     (animation-signaller true)
+                     (-> selection
+                         .transition
+                         (.duration 500)
+                         (.each "end" #(animation-signaller false))))
+        maybe-transition (if animation-signaller transition identity)
         positions (mapv (fn [node]
                           (view-position state
                                          (:pos node)
@@ -213,9 +217,9 @@
 (defn move-camera! [current-state d]
   (update-state! current-state :camera-pos add-vec d))

-(defn set-projection! [current-state projection]
+(defn set-projection! [current-state projection animation-signaller]
   (swap! current-state assoc :projection projection)
-  (sync-graph! @current-state :animate true))
+  (sync-graph! @current-state :animation-signaller animation-signaller))

 ;; Layout

@@ -287,6 +291,21 @@

 (def tick-observable (js/Rx.Observable.interval update-interval-ms))

+(defn animation-observable-and-signaller []
+  (let [observers (atom [])
+        observable (.create rx-observable #(swap! observers conj %))
+        bool->event #(if % :animation-start :animation-end)
+        animation-signaller (fn [b]
+                              (doseq [o @observers]
+                                (.onNext o (bool->event b))))]
+    [observable animation-signaller]))
+
+(defn suppress-while-animating [observable animation-observable]
+  (.flatMapLatest animation-observable
+                  (fn [e] (if (= e :animation-start)
+                            (.empty rx-observable)
+                            observable))))
+
 ;; Arrow keys

 (def key-down-observable (.fromEvent rx-observable js/document "keydown"))
@@ -307,11 +326,12 @@
 (def arrow-keys-observable
   (.map keys-observable #(->> % (map arrow-codes) (filter (comp not nil?)) (into #{}))))

-(defn move-camera-on-arrow-keys! [current-state]
+(defn move-camera-on-arrow-keys! [current-state animation-observable]
   (-> arrow-keys-observable
       (.flatMapLatest (fn [arrows] (if (empty? arrows)
                                      (.empty rx-observable)
                                      (-> tick-observable (.map (constantly arrows))))))
+      (suppress-while-animating animation-observable)
       (.subscribe
         (fn [arrows]
           (let [dx (+ (if (arrows :left) -10 0) (if (arrows :right) 10 0))
@@ -349,10 +369,10 @@
                          (math-vec (- (.-x e1-center) (.-x e2-center))
                                    (- (.-y e1-center) (.-y e2-center)))))))))

-(defn move-camera-on-pan! [manager current-state]
-  (.subscribe
-    (pan-deltas-observable manager (:svg @current-state))
-    (partial move-camera! current-state)))
+(defn move-camera-on-pan! [manager current-state animation-observable]
+  (-> (pan-deltas-observable manager (:svg @current-state))
+      (suppress-while-animating animation-observable)
+      (.subscribe (partial move-camera! current-state))))

 ;; Gestures - swipe

@@ -390,10 +410,10 @@
                                        identity
                                        (constantly update-interval-ms))))))))

-(defn move-camera-on-swipe! [manager current-state]
-  (.subscribe
-    (swipe-displacements-observable manager (:svg @current-state))
-    (partial move-camera! current-state)))
+(defn move-camera-on-swipe! [manager current-state animation-observable]
+  (-> (swipe-displacements-observable manager (:svg @current-state))
+      (suppress-while-animating animation-observable)
+      (.subscribe (partial move-camera! current-state))))

 ;; Gestures - pinch

@@ -403,18 +423,19 @@
   (.map (gesture-observable manager svg "pinchmove")
         #(.-scale %)))

-(defn zoom-out-on-pinch! [manager current-state]
+(defn zoom-out-on-pinch! [manager current-state animation-observable]
   (-> (pinch-observable manager (:svg @current-state))
+      (suppress-while-animating animation-observable)
       (.filter #(< % 0.5))
       (.subscribe #(js/alert "TODO: zoom out"))))

 ;; Temporary animation test function

-(defn zoom-in-out-on-interval! [current-state]
+(defn zoom-in-out-on-interval! [current-state animation-signaller]
   ((fn f [projection]
      (.setTimeout js/window
                   (fn []
-                    (set-projection! current-state projection)
+                    (set-projection! current-state projection animation-signaller)
                     (f (if (= projection :fisheye) :zoom-out :fisheye)))
                   2000)) :zoom-out))

@@ -426,16 +447,16 @@
         height (.-clientHeight element)
         svg (setup-svg! selector width height)
         current-state (atom (initial-state svg width height))
-        gesture-manager (hammer-manager svg)]
+        gesture-manager (hammer-manager svg)
+        [animation-observable
+         animation-signaller] (animation-observable-and-signaller)]
     (sync-graph! @current-state)
     (load-graph "miserables.json"
                 (fn [graph]
                   (let [{:keys [nodes links]} graph]
                     (swap-state! current-state assoc :nodes nodes :links links))))
-                (move-camera-on-arrow-keys! current-state)
-                (move-camera-on-pan! gesture-manager current-state)
-                (move-camera-on-swipe! gesture-manager current-state)
-                (zoom-out-on-pinch! gesture-manager current-state)
-                (zoom-in-out-on-interval! current-state)))
-
-
+                (move-camera-on-arrow-keys! current-state animation-observable)
+                (move-camera-on-pan! gesture-manager current-state animation-observable)
+                (move-camera-on-swipe! gesture-manager current-state animation-observable)
+                (zoom-out-on-pinch! gesture-manager current-state animation-observable)
+                (zoom-in-out-on-interval! current-state animation-signaller)))


Hack around iOS resizing bug

Hack around iOS resizing bug

Use the window size rather than the container size when responding to
resizes.

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -355,25 +355,36 @@

 ;; Resize

+(defn set-size! [current-state width height]
+  (let [svg (:svg @current-state)
+        background (.select svg ".background")]
+    (-> svg (.attr "width" width) (.attr "height" height))
+    (-> background (.attr "width" width) (.attr "height" height))
+    (swap-state! current-state assoc :view-size (v/create width height))))
+
+; Syncing on window size rather than the size of the surrounding container
+; avoids a layout bug on iOS in which the new container size's height is larger
+; than the screen. However, it assumes we are filling the whole screen, so if
+; we ever decide to fill less of the screen instead then we should use
+; sync-on-container-size! instead.
+
+(defn sync-on-window-size! [current-state]
+  (set-size! current-state (.-innerWidth js/window) (.-innerHeight js/window)))
+
 (defn sync-on-container-size! [current-state selector]
   (let [container (.select d3 selector)
         element (.node container)
         width (.-clientWidth element)
-        height (.-clientHeight element)
-        svg (:svg @current-state)
-        background (.select svg ".background")]
-    (-> svg (.attr "width" width) (.attr "height" height))
-    (-> background (.attr "width" width) (.attr "height" height))
-    (swap-state! current-state assoc :view-size (v/create width height))))
+        height (.-clientHeight element)]
+    (set-size! current-state width height)))

 (def resize-observable
   (-> rx-observable (.fromEvent js/window "resize")
-      (.map :resize)
       (.debounce resize-delay-ms)))

 (defn respond-to-resize! [current-state selector]
   (.subscribe resize-observable
-              #(sync-on-container-size! current-state selector)))
+              #(sync-on-window-size! current-state selector)))

 ;; Animation

@@ -580,7 +591,7 @@
     {:node @closest-node
      :distance (js/Math.sqrt @closest-distance-sq)}))

-(defn focus-node-on-tap-2! [manager current-state animation-observable]
+(defn focus-node-on-tap! [manager current-state animation-observable]
   (let [taps (tap-observable manager)]
     (-> taps
         (suppress-while-animating animation-observable)
@@ -603,7 +614,7 @@
                                            width
                                            height
                                            animation-subject))]
-    (sync-on-container-size! current-state selector)
+    (sync-on-window-size! current-state)
     (load-graph "miserables.json"
                 (fn [graph]
                   (let [{:keys [nodes links]} graph]
@@ -615,4 +626,4 @@
     (switch-zoom-on-spacebar! current-state animation-subject)
     (zoom-on-pinch! gesture-manager current-state animation-subject)
     (zoom-in-on-tap! gesture-manager current-state animation-subject)
-    (focus-node-on-tap-2! gesture-manager current-state animation-subject)))
+    (focus-node-on-tap! gesture-manager current-state animation-subject)))


Some validation

Some validation

--- src/icecap/api.clj
+++ src/icecap/api.clj
@@ -3,7 +3,7 @@
   (:require [taoensso.nippy :as nippy]
             [icecap.handlers.http]
             [icecap.handlers.delay]
-            [icecap.schema :refer [validate-plan]]
+            [icecap.schema :refer [check-plan]]
             [clojure.core.async :refer [<!! <! >!! go] :as async]
             [icecap.handlers.core :refer [execute]]
             [icecap.crypto :as crypto]
@@ -13,13 +13,18 @@
 (defn create-cap
   "Creates a capability."
   [plan & {store :store kdf :kdf scheme :scheme}]
-  (validate-plan plan)
-  (let [cap (crypto/make-cap)
-        {index :index cap-key :cap-key} (crypto/derive kdf cap)
-        encoded-plan (nippy/freeze plan)
-        blob (crypto/encrypt scheme cap-key encoded-plan)
-        ch (create! store index blob)]
-    (async/into {:cap cap} ch)))
+  (let [validation (spy (check-plan plan))]
+    (if (nil? validation)
+      (let [cap (crypto/make-cap)
+            {index :index cap-key :cap-key} (crypto/derive kdf cap)
+            encoded-plan (nippy/freeze plan)
+            blob (crypto/encrypt scheme cap-key encoded-plan)
+            ch (create! store index blob)]
+        (async/into {:cap cap} ch))
+      (let [ch (async/chan)]
+        (>!! ch validation)
+        (async/close! ch)
+        ch))))

 (defn execute-cap
   "Executes a capability."


Fixed broken tests

Fixed broken tests

--- collectors/snapshot/test/snapshot_collector/core_test.clj
+++ collectors/snapshot/test/snapshot_collector/core_test.clj
@@ -1,24 +1,25 @@
 (ns snapshot-collector.core-test
   (:require [midje.sweet :refer :all]
+            [kuona-core.cli :as cli]
             [snapshot-collector.core :refer :all]))

 (facts "about command line interface"
        (fact "uses defaults if no arguments supplied"
-             (validate-args []) => {:api-url   "http://dashboard.kuona.io"
-                                    :force     false
-                                    :workspace "/Volumes/data-drive/workspace"})
+             (cli/validate-args "snap" cli-options []) => {:api-url   "http://dashboard.kuona.io"
+                                                           :force     false
+                                                           :workspace "/Volumes/data-drive/workspace"})
        (fact "can supply short parameters"
-             (validate-args ["-a" "http://localhost" "-f" "-w" "/some/path"]) => {:api-url   "http://localhost"
-                                                                                :force     true
-                                                                                :workspace "/some/path"})
+             (cli/validate-args "snap" cli-options  ["-a" "http://localhost" "-f" "-w" "/some/path"]) => {:api-url   "http://localhost"
+                                                                                :force     true
+                                                                                :workspace "/some/path"})
        (fact "can supply long parameters"
-             (validate-args ["--api-url" "http://localhost" "--force" "--workspace" "/some/path"]) => {:api-url   "http://localhost"
-                                                                                :force     true
-                                                                                :workspace "/some/path"})
+             (cli/validate-args "snap" cli-options ["--api-url" "http://localhost" "--force" "--workspace" "/some/path"]) => {:api-url   "http://localhost"
+                                                                                :force     true
+                                                                                :workspace "/some/path"})
        (fact "invalid options produce error"
-             (validate-args ["--foo"]) => {:exit-message "The following errors occurred while parsing your command:\n\nUnknown option: \"--foo\""}
-             (:ok? (validate-args ["--foo"])) => nil)
+             (cli/validate-args "snap" cli-options ["--foo"]) => {:exit-message "The following errors occurred while parsing your command:\n\nUnknown option: \"--foo\""}
+             (:ok? (cli/validate-args "snap" cli-options ["--foo"])) => nil)
        (fact "help support"
-             (:ok? (validate-args ["-h"])) => true
-             (contains? (validate-args ["-h"]) :exit-message) => true))
+             (:ok? (cli/validate-args "snap" cli-options ["-h"])) => true
+             (contains? (cli/validate-args "snap" cli-options ["-h"]) :exit-message) => true))


Move dynamic vars to re-db.core

Move dynamic vars to re-db.core

--- src/re_db/d.clj
+++ src/re_db/d.clj
@@ -1,19 +1,15 @@
 (ns re-db.d)
-
-(def *db-log* 're-db.core/*db-log*)
-(def *db* 're-db.d/*db*)
-(def *mute* 're-db.core/*mute*)

 (defmacro branch [db & body]
   `(let [db-before# ~db]
-     (binding [~*db* (~'atom db-before#)
-               ~*mute* true
-               ~*db-log* (~'atom (or (~'some-> ~*db-log* ~'deref)
-                                     {:db-before db-before#
-                                      :db-after  db-before#
-                                      :reports   {}}))]
+     (binding [~'re-db.d/*db* (~'atom db-before#)
+               ~'re-db.core/*mute* true
+               ~'re-db.core/*db-log* (~'atom (or (~'some-> ~'re-db.core/*db-log* ~'deref)
+                                                 {:db-before db-before#
+                                                  :db-after  db-before#
+                                                  :reports   {}}))]
        (do ~@body)
-       @~*db-log*)))
+       @~'re-db.core/*db-log*)))

 (defmacro try-branch [db on-error & body]
   `(let [db-before# ~db]


CMR-4703 - changes from PR review

CMR-4703 - changes from PR review

--- system-int-test/test/cmr/system_int_test/search/collection_concept_retrieval_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_concept_retrieval_test.clj
@@ -164,7 +164,7 @@
                                                 :url-extension "html"})
             _ (is (= 200 (:status response)))]
         (is (search/mime-type-matches-response? response mt/html))
-        (is (= "C1200000016-PROV1" (:concept-id coll1) ))
+        (is (.contains ^String (:body response) (:concept-id coll1)))
         (is (.contains ^String (:body response) (:entry-title umm-coll)))))
     (testing "retrieval of HTML with accept headers"
       (let [response (search/retrieve-concept


handle message send button

handle message send button

--- src_cljs/cljat_webapp/cljat_webapp/app.cljs
+++ src_cljs/cljat_webapp/cljat_webapp/app.cljs
@@ -320,17 +320,14 @@
 (defn chat-input [ch-out]
   (let [input-value (r/atom "")]
     (fn []
-      (let [on-change (fn [e]
-                        (reset! input-value (.-value (.-target e))))
-            on-key-press (fn [e]
-                           (when (and
-                                   (= 13 (.-charCode e))
-                                   (seq @input-value))
-                             (put! ch-out [:cljat/chat-msg {:data {:sent-from (.-uid js/cljat)
-                                                                   :sent-to (get-in @sidebar-tab-stats [:threads :cur])
-                                                                   :msg-str @input-value}}])
-                             (js/console.log "message sent")
-                             (reset! input-value "")))]
+      (let [send-fn (fn []
+                      (put! ch-out [:cljat/chat-msg {:data {:sent-from (.-uid js/cljat)
+                                                            :sent-to (get-in @sidebar-tab-stats [:threads :cur])
+                                                            :msg-str @input-value}}])
+                      (reset! input-value ""))
+
+            on-change (fn [e]
+                        (reset! input-value (.-value (.-target e))))]
         [:div {:id "chat-input" :class "input-box"}
          [:input {:id "msg-input"
                   :value @input-value
@@ -338,8 +335,12 @@
                   :size 50
                   :placeholder "Write Message ..."
                   :on-change on-change
-                  :on-key-press on-key-press}]
-         [:span [:input {:id "send-btn" :type "submit" :value "send"}]]]))))
+                  :on-key-press (fn [e]
+                                  (when (and
+                                          (= 13 (.-charCode e))
+                                          (seq @input-value))
+                                    (send-fn)))}]
+         [:span [:input {:id "send-btn" :type "submit" :value "send" :on-click #(send-fn)}]]]))))

 (defn chat [ch-out]
   (fn []


Use git-ls-tree instead of git-ls-files.

Git is not helping us. It was ignoring the commit version as ls-tree
is really /only/ about reading the index/staging area. ls-tree is
slower but gives us the right results (instead of constantly giving us
the current index).

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1162,11 +1162,11 @@
                       (count (:parents commit)) (:parents commit))
         (->/for [parent (:parents commit)]
           (pldb/db-fact r-commit-parent sha parent))
-        (->/for [[mode bsha stage path]
+        (->/for [[mode otype bsha path]
                  , (->> (git {:gitdir gitdir}
-                             "ls-files" "--stage" (str sha)
-                             "--" "project.clj" "**/project.clj")
+                             "ls-tree" "-r" "--full-tree" (str sha))
                         :lines
+                        (filter #(re-find #"(^|/)project.clj$" %))
                         (map #(s/split % #"\s+" 4)))
                    :let [blob-sha (sha/mk bsha)]]
           (->/as pldb


Fix issue in 'parse-tag where an unparsed tag would return "" instead of nil.

The problem with returning "" instead of nil is that "" matches
projects at the root (which have a path of "") when they should not
match at all.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -385,8 +385,8 @@
   [tag]
   (->
    (zipmap [:prefix :proj :ver :path :sha :no-parent] (s/split tag #"--"))
-   (update-in [:path] (fnil s/replace "") #"%" "/")
-   (update-in [:proj] (fnil s/replace "") #"%" "/")))
+   (update-in [:path] (fnil #(s/replace % #"%" "/") :NOT_FOUND))
+   (update-in [:proj] (fnil #(s/replace % #"%" "/") :NOT_FOUND))))

 (defn origin-branches
   [gitdir]


Use exception-cause? instead of thrown?

Use exception-cause? instead of thrown?

--- test/clj/backtype/storm/security/serialization/BlowfishTupleSerializer_test.clj
+++ test/clj/backtype/storm/security/serialization/BlowfishTupleSerializer_test.clj
@@ -1,6 +1,7 @@
 (ns backtype.storm.security.serialization.BlowfishTupleSerializer-test
-  (:use [
-         clojure test])
+  (:use [clojure test]
+        [backtype.storm.util :only (exception-cause?)]
+  )
   (:import [backtype.storm.security.serialization BlowfishTupleSerializer]
            [backtype.storm.utils ListDelegate]
            [com.esotericsoftware.kryo Kryo]
@@ -8,22 +9,14 @@
   )
 )

-; Exceptions are getting wrapped in RuntimeException.  This might be due to
-; CLJ-855.
-(defn- unpack-runtime-exception [expression]
-  (try (eval expression)
-    nil
-    (catch java.lang.RuntimeException gripe
-      (throw (.getCause gripe)))
-  )
-)
-
 (deftest test-constructor-throws-on-null-key
   (let [conf {}]
-    (is (thrown? java.lang.RuntimeException
-      (unpack-runtime-exception
-        '(new BlowfishTupleSerializer nil conf)))
-      "Throws RuntimeException when no encryption key is given."
+    (try
+      (new BlowfishTupleSerializer nil conf)
+      (catch Throwable t
+        (is (exception-cause? java.lang.RuntimeException t)
+        "Throws RuntimeException when no encryption key is given.")
+      )
     )
   )
 )


try and find the non-string files/join

try and find the non-string files/join

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

--- src/lt/objs/files.cljs
+++ src/lt/objs/files.cljs
@@ -269,7 +269,10 @@
     (catch js/global.Error e)))

 (defn join [& segs]
-  (apply (.-join fpath) (filter identity segs)))
+  (when (filter (complement string?) segs)
+    (.trace js/console)
+    (println "Trying to join non-string: " segs))
+  (apply (.-join fpath) (filter string? segs)))

 (defn home [path]
   (let [h (if (= js/process.platform "win32")