(PE-5344) DRYed out authority-key-identifier Clojure function

This commit extracts some of the redundant map setup in the different
arities of the `authority-key-identifier` function into a helper
function, `create-authority-key-identifier`.  The helper function takes
advantage of the fact that the underlying Java method that interprets
the map was already able to handle the absence of a key in the map vs.
the presence of the key but with a null value as being equivalent.

--- src/clojure/puppetlabs/certificate_authority/core.clj
+++ src/clojure/puppetlabs/certificate_authority/core.clj
@@ -157,6 +157,14 @@
    :critical false
    :value    comment})

+(defn- create-authority-key-identifier
+  [public-key issuer-dn serial critical]
+  {:oid      "2.5.29.35"
+   :critical (boolean critical)
+   :value    {:public-key    public-key
+              :serial-number (if (number? serial) (biginteger serial))
+              :issuer-dn     issuer-dn}})
+
 (defn authority-key-identifier
   "Create an `Authority Key Identifier` extension from a `PublicKey` object. The
   extension created by this function is intended to be passed into
@@ -165,27 +173,18 @@
   ([public-key critical]
     {:pre [(public-key? public-key)]
      :post [(extension? %)]}
-    {:oid      "2.5.29.35"
-     :critical (boolean critical)
-     :value    {:public-key public-key}})
+    (create-authority-key-identifier public-key nil nil critical))
   ([issuer-dn serial critical]
     {:pre [(number? serial)
            (valid-x500-name? issuer-dn)]
      :post [(extension? %)]}
-    {:oid      "2.5.29.35"
-     :critical (boolean critical)
-     :value    {:serial-number (biginteger serial)
-                :issuer-dn     issuer-dn}})
+    (create-authority-key-identifier nil issuer-dn serial critical))
   ([public-key issuer-dn serial critical]
-   {:pre [(public-key? public-key)
-          (number? serial)
-          (valid-x500-name? issuer-dn)]
-    :post [(extension? %)]}
-   {:oid      "2.5.29.35"
-    :critical (boolean critical)
-    :value    {:public-key    public-key
-               :serial-number (biginteger serial)
-               :issuer-dn     issuer-dn}}))
+    {:pre [(public-key? public-key)
+           (valid-x500-name? issuer-dn)
+           (number? serial)]
+     :post [(extension? %)]}
+    (create-authority-key-identifier public-key issuer-dn serial critical)))

 (defn subject-key-identifier
   "Create a `Subject Key Identifier` extension from a `PublicKey` object. The


Minor changes to search granules by cloud cover test w.r.t error checking

--- test/cmr/system_int_test/search/granule_search_test.clj
+++ test/cmr/system_int_test/search/granule_search_test.clj
@@ -212,41 +212,35 @@
            {"cloud_cover" "-70.0,120.0"} [gran1 gran2 gran3 gran4 gran5]))
     (testing "search by cloud-cover with min value greater than max value"
       (let [min-value 30.0
-            max-value 0.0
-            num-range (format "%s,%s" min-value max-value)
-            {:keys [status errors]} (search/find-refs :granule {"cloud_cover" num-range})
-            error (first errors)]
-        (is (= 422 status))
-        (is (= error (vmsg/min-value-greater-than-max  min-value max-value)))))
-    (testing "search by cloud-cover with non numeric str"
-      (let [num-range "c9c,"
-            {:keys [status errors]} (search/find-refs :granule {"cloud_cover" num-range})
-            error (first errors)]
-        (is (= 422 status))
-        (is (= error (msg/invalid-numeric-range-msg num-range)))))
-    (testing "search by cloud-cover with non numeric str"
-      (let [num-range ",99c"
-            {:keys [status errors]} (search/find-refs :granule {"cloud_cover" num-range})
-            error (first errors)]
-        (is (= 422 status))
-        (is (= error (msg/invalid-numeric-range-msg num-range)))))
-    (testing "search by cloud-cover with non numeric str"
-      (let [num-range ","
-            {:keys [status errors]} (search/find-refs :granule {"cloud_cover" num-range})
-            error (first errors)]
-        (is (= 422 status))
-        (is (= error (msg/invalid-numeric-range-msg num-range)))))
-    (testing "search by cloud-cover with non numeric str"
-      (let [num-range ""
-            {:keys [status errors]} (search/find-refs :granule {"cloud_cover" num-range})
-            error (first errors)]
-        (is (= 422 status))
-        (is (= error (msg/invalid-numeric-range-msg num-range)))))
+            max-value 0.0]
+        (is (= {:status 422
+                :errors [(vmsg/min-value-greater-than-max min-value max-value)]}
+               (search/find-refs :granule {"cloud_cover" (format "%s,%s" min-value max-value)})))))
+    (testing "search by cloud-cover with non numeric str 'c9c,'"
+      (let [num-range "c9c,"]
+        (is (= {:status 422
+                :errors [(msg/invalid-numeric-range-msg num-range)]}
+               (search/find-refs :granule {"cloud_cover" num-range})))))
+    (testing "search by cloud-cover with non numeric str ',99c'"
+      (let [num-range ",99c"]
+        (is (= {:status 422
+                :errors [(msg/invalid-numeric-range-msg num-range)]}
+               (search/find-refs :granule {"cloud_cover" num-range})))))
+    (testing "search by cloud-cover with non numeric str ','"
+      (let [num-range ","]
+        (is (= {:status 422
+                :errors [(msg/invalid-numeric-range-msg num-range)]}
+               (search/find-refs :granule {"cloud_cover" num-range})))))
+    (testing "search by cloud-cover with empty str"
+      (let [num-range ""]
+        (is (= {:status 422
+                :errors [(msg/invalid-numeric-range-msg num-range)]}
+               (search/find-refs :granule {"cloud_cover" num-range})))))
     (testing "search by cloud-cover with invalid range"
-      (let [num-range "30,c9c"
-            {:keys [status errors]} (search/find-refs :granule {"cloud_cover" num-range})
-            error (first errors)]
-        (is (= 422 status))
-        (is (= error (msg/invalid-numeric-range-msg num-range)))))))
-
-
+      (let [num-range "30,c9c"]
+        (is (= {:status 422
+                :errors [(msg/invalid-numeric-range-msg num-range)]}
+               (search/find-refs :granule {"cloud_cover" num-range})))))))
+
+
+


CMR-343: modified tests numeric range w.r.t cloud cover.

--- test/cmr/system_int_test/search/granule_search_test.clj
+++ test/cmr/system_int_test/search/granule_search_test.clj
@@ -17,7 +17,7 @@

   )

-(deftest search-by-provider-id
+#_(deftest search-by-provider-id
   (let [coll1 (d/ingest "CMR_PROV1" (dc/collection {}))
         coll2 (d/ingest "CMR_PROV2" (dc/collection {}))
         gran1 (d/ingest "CMR_PROV1" (dg/granule coll1 {:granule-ur "Granule1"}))
@@ -56,7 +56,7 @@
         (is (is (= #{"Granule1" "Granule2" "Granule3"}
                    (set (map :name refs)))))))))

-(deftest search-by-dataset-id
+#_(deftest search-by-dataset-id
   (let [coll1 (d/ingest "CMR_PROV1" (dc/collection {:entry-title "OneCollectionV1"}))
         coll2 (d/ingest "CMR_PROV1" (dc/collection {:entry-title "AnotherCollectionV1"}))
         coll3 (d/ingest "CMR_PROV2" (dc/collection {:entry-title "OneCollectionV1"}))
@@ -127,7 +127,7 @@
                  {:entry-title "TestCollection"
                   :granule-ur "sampleur3"}]})

-(deftest search-by-granule-ur
+#_(deftest search-by-granule-ur
   (let [coll1 (d/ingest "CMR_PROV1" (dc/collection {}))
         coll2 (d/ingest "CMR_PROV2" (dc/collection {}))
         gran1 (d/ingest "CMR_PROV1" (dg/granule coll1 {:granule-ur "Granule1"}))
@@ -187,7 +187,6 @@
                (set (map :name refs))))))))

-(deftest search-by-cloud-cover
   (let [coll1 (d/ingest "CMR_PROV1" (dc/collection {}))
         coll2 (d/ingest "CMR_PROV2" (dc/collection {}))
         gran1 (d/ingest "CMR_PROV1" (dg/granule coll1 {:cloud-cover 0.8}))
@@ -199,20 +198,23 @@
     (index/flush-elastic-index)
     (testing "search granules with lower bound cloud-cover value"
       (are [cc-search items] (d/refs-match? items (search/find-refs :granule cc-search))
-           {"cloud_cover[min]" 0.2} [gran1 gran2 gran3]))
+           {"cloud_cover" "0.2,"} [gran1 gran2 gran3]))
     (testing "search granules with upper bound cloud-cover value"
       (are [cc-search items] (d/refs-match? items (search/find-refs :granule cc-search))
-           {"cloud_cover[max]" 0.7} [gran4 gran5]))
+           {"cloud_cover" ",0.7"} [gran4 gran5]))
     (testing "search by cloud-cover range values that would not cover all granules in store"
       (are [cc-search items] (d/refs-match? items (search/find-refs :granule cc-search))
-           {"cloud_cover[min]" -70.0 "cloud_cover[max]" 31.0} [gran1 gran2 gran4 gran5]))
+           {"cloud_cover" "-70.0,31.0"} [gran1 gran2 gran4 gran5]))
     (testing "search by cloud-cover range values that would not cover all granules in store"
       (are [cc-search items] (d/refs-match? items (search/find-refs :granule cc-search))
-           {"cloud_cover[min]" -70.0 "cloud_cover[max]" 120.0} [gran1 gran2 gran3 gran4 gran5]))
+           {"cloud_cover" "-70.0,120.0"} [gran1 gran2 gran3 gran4 gran5]))
     (testing "search by cloud-cover with min value greater than max value"
-      (let [{:keys [status errors]} (search/find-refs :granule {"cloud_cover[min]" 30 "cloud_cover[max]" 0})]
+      (let [{:keys [status errors]} (search/find-refs :granule {"cloud_cover" "30,0"})
+            err (first errors)]
         (is (= 422 status))
-        (is (re-find #"cloud_cover max value must greater than cloud_cover min value" (first errors)))))))
-
-
-
+        (is (re-find #"The maximum value" err))
+        (is (re-find #"must be greater than or equal to the minimum value" err))))))
+
+
+
+


add docstring for fns make-hystrix-command-metrics-source and make-hystrix-thread-pool-metrics-source

--- src/preflex/resilient/hystrix.clj
+++ src/preflex/resilient/hystrix.clj
@@ -233,6 +233,8 @@

 (defn make-hystrix-command-metrics-source
+  "Given command name, metrics reporter fn `(fn []) -> map` and fallback metric reporter fn `(fn []) -> map` construct
+  and return a fn (fn []) -> HystrixCommandMetrics."
   [command-name metrics-reporter fallback-metrics-reporter]
   (fn []
     (let [{:keys [;; -- cumulative counts --
@@ -392,6 +394,8 @@

 (defn make-hystrix-thread-pool-metrics-source
+  "Given thread-pool name and thread-pool metrics reporter fn `(fn []) -> map` construct and return a fn
+  `(fn []) -> HystrixThreadPoolMetrics`."
   [thread-pool-name thread-pool-metrics-reporter]
   (fn []
     (let [{:keys [rolling-count-max-active-threads


simplifying basic eval api

simplifying basic eval api

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -173,7 +173,8 @@

 (defn eval* [env bound-vars form opts cb]
   (let [ana-env (ana/empty-env)]
-    (binding [ana/*cljs-ns*    (:*cljs-ns* bound-vars)
+    (binding [*eval-fn*        (:*eval-fn* bound-vars)
+              ana/*cljs-ns*    (:*cljs-ns* bound-vars)
               *ns*             (:*ns* bound-vars)
               r/*data-readers* (:*data-readers* bound-vars)
               env/*compiler*   env]
@@ -188,5 +189,6 @@
      (eval* env
        {:*cljs-ns*      (or (:ns env) 'cljs.user)
         :*ns*           (create-ns ana/*cljs-ns*)
-        :*data-readers* tags/*cljs-data-readers*}
+        :*data-readers* tags/*cljs-data-readers*
+        :*eval-fn*      (or (:js-eval opts) js/eval)}
        form opts cb))))


boolean? -> true?

boolean? -> true?

--- src/main/om_css/utils.cljc
+++ src/main/om_css/utils.cljc
@@ -23,7 +23,7 @@
               (keyword? cns))
             (let [cns' (map #(cond->> %
                                (and classes-seen
-                                 (if (boolean? classes-seen)
+                                 (if (true? classes-seen)
                                    classes-seen
                                    (get classes-seen %))) (format-class-name component-info))
                          (if (sequential? cns) cns [cns]))]


removed debug print

removed debug print

--- main/src/dda/pallet/dda_serverspec_crate/infra/fact/command.clj
+++ main/src/dda/pallet/dda_serverspec_crate/infra/fact/command.clj
@@ -67,7 +67,6 @@

 (s/defn collect-command-fact
   [fact-config :- CommandFactConfig]
-  (print fact-config)
   (collect-fact
     fact-id-command
     (str


rename

rename

--- src/otp_api_proxy/core.clj
+++ src/otp_api_proxy/core.clj
@@ -255,6 +255,8 @@
             minduration (reduce min durations)]
         (-> fst
             (dissoc :duration)
+            (dissoc :startTime)
+            (dissoc :endTime)
             (assoc :minDuration minduration)
             (assoc :maxDuration maxduration)
             (assoc :countWithThisRouteSequence num-itins))))))
@@ -423,7 +425,7 @@
   (context "/trip-planner/:otp-instance" [otp-instance]
      (ANY "/plan" request
        (ws-otp-with-args (:params request)))
-     (ANY "/plan-merge-by-route-sequence" request
+     (ANY "/plan-then-merge-by-route-sequence" request
        (ws-otp-merge-by-route-sequence (:params request)))
      (ANY "/plan-cooked" []
        (ws-otp-cooked))


Remove extra parens

Remove extra parens

--- test/promesa/tests/core_test.cljc
+++ test/promesa/tests/core_test.cljc
@@ -303,13 +303,13 @@
        (let [prm (-> (p/delay 200 :value)
                      (p/timeout 300))]
          (p/then prm (fn [v]
-                        (t/is (= (v :value)))
+                        (t/is (= v :value))
                         (done)))))
      :clj
      (let [prm (-> (p/delay 200 :value)
                    (p/timeout 500))]
        @(p/then prm (fn [v]
-                     (t/is (= (v :value))))))))
+                     (t/is (= v :value)))))))

 (t/deftest chaining-using-chain
   #?(:cljs


No more tutorial from tryclojure.

No more tutorial from tryclojure.

--- src/tryclojure/views/tutorial.clj
+++ src/tryclojure/views/tutorial.clj
@@ -1,5 +0,0 @@
-(ns tryclojure.views.tutorial
-  (:require [noir.core :refer [defpage]]))
-
-(defpage [:post "/tutorial"] {n :n}
-  (slurp (str "resources/public/tutorial/page" n ".html")))


make sure to do an update on conv immediately after loaded in conv-actor

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -363,6 +363,8 @@
   (log/info "Starting message batch queue and handler routine for conv zid:" zid)
   (let [conv (load-or-init conv-man zid :recompute (:recompute config))
         _ (log/info "Conversation loaded for conv zid:" zid)
+        conv (conv/conv-update conv [])
+        _ (log/info "Initial conv update complete for zid:" zid)
         ;; Set up our main message chan
         message-chan (chan 10000)
         ;; Separate channel for messages that we've tried to process but that haven't worked for one reason or another (buffer size not important here)


note for posterity

note for posterity

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -207,6 +207,8 @@
 ;; in one place. This problem with teh :lastVoteTimestamp and group-votes etc came up precisely because there
 ;; wasn't "one place to go" for modifying all of the potential points of interest for these kind of changes.

+;; ^ I'm leaving this note in for posterity, but note that this is exactly what spec is :-)
+
 ;; XXX However, we shouldn't even be pushing the results to mongo if we didn't actually update anything

 (defn restructure-mongo-conv


More scratch in intercom ns

More scratch in intercom ns

--- src/polismath/intercom.clj
+++ src/polismath/intercom.clj
@@ -93,23 +93,54 @@
     (client/post "https://api.intercom.io/users")))

+
+(def db-spec      (poll/heroku-db-spec (env/env :database-url)))
+(def users        (get-intercom-users))
+(def valid-ids    (valid-user-ids users))
+(def users-w-ids  (filter #(get % "user_id") users))
+(def users-wo-ids (filter #(not (get % "user_id")) users))
+
+(def good-id-by-email (get-db-users-by-email db-spec (map #(get % "email") users-w-ids)))
+(def good-id-by-email-ids (set (map :uid good-id-by-email)))
+(def bad-emails-good-ids-users (remove #(good-id-by-email-ids (Integer/parseInt (get % "user_id"))) users-w-ids))
+(def bad-emails-good-ids-ids (set (map #(get % "user_id") bad-emails-good-ids-users)))
+(def bad-emails-good-ids-dbrecs
+  (get-db-users-by-uid
+    db-spec
+    (map #(Integer/parseInt (get % "user_id")) bad-emails-good-ids-users)))
+
+(map :email bad-emails-good-ids-dbrecs)
+(map #(get % "email") bad-emails-good-ids-users)
+
+(filter #(= "27306" (get % "user_id")) users)
+
+
+;(update-intercom-user {:email "chris@pol.is" :remote_created_at (/ 1408088823591 1000)})
+
+;(get (first (filter #(= "kelly.baumeister@bigfishgames.com" (get % "email")) users)) "id")
+;(update-intercom-user {:id "531a50cb9db3ee100400b450"
+                       ;:user_id 26371
+                       ;:remote_created_at (/ 1395873111736 1000)})
+
 (defn -main
   []
   (let [db-spec      (poll/heroku-db-spec (env/env :database-url))
         users        (get-intercom-users)
         valid-ids    (valid-user-ids users)
+        users-w-ids  (filter #(get % "user_id") users)
         users-wo-ids (filter #(not (get % "user_id")) users)]
     ; First some nice summary stats information
     (println "Total number of users:         " (count users))
     (println "Number of users with valid ids:" (count valid-ids))
     (println "Number w/o:                    " (count users-wo-ids))
     ; Getting to work...
-    ; First take care of all the ones which have valid ids. These tend to be more recent, but also
+    ; First take care of all the ones which have valid ids. These tend to be more recent.
+    ; It appears that all of the users with
+    (doseq [u users-w-ids]
+      (println (gets u ["email"])))
     (->>
       valid-ids
-      (get-db-users-by-uid db-spec)
-      (count)
-      (println "Fetched users w/ ids:"))
+      (get-db-users-by-uid db-spec))
     ; Now we deal with the ones without valid uids. For these we match with email.
     (->>
       users-wo-ids


only fall back to ajax if it doesn't support websockets

--- src-cljs/frontend/talaria.cljs
+++ src-cljs/frontend/talaria.cljs
@@ -246,7 +246,8 @@
                (swap! tal-state (fn [s]
                                   (-> s
                                     (assoc :open? true
-                                           :keep-alive-timer timer-id)
+                                           :keep-alive-timer timer-id
+                                           :supports-websockets? true)
                                     (dissoc :closed? :close-code :close-reason)))))
              (start-send-queue tal-state 30)
              (when (and reconnecting? (fn? on-reconnect))
@@ -269,7 +270,8 @@
              (when (fn? on-close)
                (on-close tal-state {:code code
                                     :reason reason}))
-             (if (= 1006 code)
+             (if (and (= 1006 code)
+                      (not (:supports-websockets? @tal-state)))
                ;; ws failed, lets try ajax
                (utils/apply-map setup-ajax url-parts tal-state args)
                (js/setTimeout (fn []


Push benchmark code

Push benchmark code

--- src/aurora/examples/todomvc2.cljs
+++ src/aurora/examples/todomvc2.cljs
@@ -592,8 +592,45 @@
   (perf-time
    (do (defaults todomvc)
      (init-std-lib todomvc)
-     (fill-todos todomvc 10)
+     (fill-todos todomvc 200)
      (re-run todomvc)))
+
+  (perf-time (re-run todomvc))
+
+  (do
+    (defaults todomvc)
+    (init-std-lib todomvc)
+    (fill-todos todomvc 200)
+    (def compiled (perf-time (compile todomvc)))
+    (prep-compiled compiled)
+    (perf-time
+     (js/console.profile)
+     (dotimes [i 1000]
+       (do
+         (perf-time
+          (.quiesce compiled todomvc (fn [kn]
+                                       (let [tree (perf-time (rebuild-tree todomvc (aget (.-state todomvc) "queue!")))
+                                             container (dom/$ "body")
+                                             dommied (perf-time (dommy/node tree))
+                                             ]
+                                         (when container
+                                           (perf-time (js/React.renderComponent dommied container))
+                                           ;(perf-time (do
+                                           ;             (dom/empty container)
+                                           ;             (dom/append container tree)))
+                                           )
+                                         ;
+                                         )
+                                       )))
+         (aset (.-state todomvc) "queued" false)
+         ))
+     (js/console.profileEnd)))
+
+  (for [[_ x] (.-kind->name->fields->index todomvc)
+        [name indexes] x]
+    [name (count indexes)])
+
+  (get-in (.-kind->name->fields->index todomvc) ["know" ""])

 (let [program (env)]
   (rules program


use nth instead of get for retrieving first element of vector

--- src/clj/com/rpl/specter/impl.cljx
+++ src/clj/com/rpl/specter/impl.cljx
@@ -467,7 +467,7 @@
 (extend-protocol UpdateExtremes
   #+clj clojure.lang.IPersistentVector #+cljs cljs.core/PersistentVector
   (update-first [v afn]
-    (let [val (get v 0)]
+    (let [val (nth v 0)]
       (assoc v 0 (afn val))
       ))
   (update-last [v afn]
@@ -487,7 +487,7 @@
 (extend-protocol GetExtremes
   #+clj clojure.lang.IPersistentVector #+cljs cljs.core/PersistentVector
   (get-first [v]
-    (get v 0))
+    (nth v 0))
   (get-last [v]
     (peek v))
   #+clj Object #+cljs default


Fixed typo

Fixed typo

--- src/clj/funstructor/processes.clj
+++ src/clj/funstructor/processes.clj
@@ -239,7 +239,7 @@
   (let [game-id (u/next-id!)
         game-state-ch (a/chan) ;; TODO: Consider using sliding buffer for this chan

-        initial-game-map (f/init-game (f/make-gameme
+        initial-game-map (f/init-game (f/make-game
                                        (:id p1-info)
                                        (:id p2-info)
                                        (:name p1-info)


Fix popover width and gist position on mobile. Fixes #139

--- src/cljs/cljs_repl_web/views.cljs
+++ src/cljs/cljs_repl_web/views.cljs
@@ -105,9 +105,15 @@
     (utils/open-new-window (:html_url response))
     (dispatch [:set-gist-error-msg "An error occured: unable to create gist."])))

+(defn gist-position
+  "Calulates the gist position depending on the media query"
+  [media-query]
+  (if (= :narrow @media-query) :below-center :right-center))
+
 (defn gist-login-dialog-body
   []
   (let [showing? (subscribe [:gist-showing?])
+        media-query (subscribe [:media-query-size])
         auth-data (subscribe [:gist-auth-data])
         ok-fn #(dispatch [:create-gist :cljs-console auth-data on-gist-created gist-error-handler])
         cancel-fn #(dispatch [:hide-gist-login])]
@@ -116,7 +122,7 @@
        [popover-content-wrapper
         :showing? showing?
         :on-cancel cancel-fn
-        :position :right-center
+        :position (gist-position media-query)
         :width "280"
         :backdrop-opacity 0.4
         :title "Github login"
@@ -159,11 +165,12 @@
 (defn gist-login-dialog
   []
   (let [can-dump-gist? (subscribe [:can-dump-gist? :cljs-console])
-        showing? (subscribe [:gist-showing?])]
+        showing? (subscribe [:gist-showing?])
+        media-query (subscribe [:media-query-size])]
     (fn []
       [popover-anchor-wrapper
        :showing? showing?
-       :position :right-center
+       :position (gist-position media-query)
        :anchor   [md-icon-button
                   :md-icon-name "zmdi-github"
                   :on-click #(dispatch [:show-gist-login])
@@ -344,64 +351,65 @@
 (defn symbol-popover
   "A popover's body in which details of the given symbol will be shown."
   [showing-atom position-atom sym-doc-map]
-  (let [{name :name
-         full-name :full-name
-         desc :description
-         docstring :docstring
-         examples-htmls :examples-htmls
-         examples-strings :examples-strings
-         sign :signature
-         related :related} sym-doc-map
-        desc (or desc docstring) ; some symbols don't have a description so we use
+  (let [media-query (subscribe [:media-query-size])]
+    (fn symbol-popover-form2 [showing-atom position-atom sym-doc-map]
+      (let [{name :name
+             full-name :full-name
+             desc :description
+             docstring :docstring
+             examples-htmls :examples-htmls
+             examples-strings :examples-strings
+             sign :signature
+             related :related} sym-doc-map
+             desc (or desc docstring) ; some symbols don't have a description so we use
                                         ; the docstring instead; docstring is a regular string,
                                         ; without markdown. Nonetheless, it will be passed to
                                         ; md->react->component function to gain some basic html
                                         ; formatting (like paragraphs)
-        examples (map (fn [html string] {:html html :strings string}) examples-htmls examples-strings)
-        popover-width  400
-        popover-height 400
-        popover-content-width (- popover-width (* 2 14) 15)] ; bootstrap padding + scrollbar width
-    (fn symbol-popover-form2 [showing-atom position-atom sym-doc-map]
-      [popover-content-wrapper
-       :showing? showing-atom
-       :position @position-atom
-       :on-cancel (handler-fn (reset! showing-atom false))
-       :style {:max-height (str popover-height)
-               :max-width (str popover-width)}
-       :backdrop-opacity 0.1
-       :close-button? false
-       :title [h-box
-               :gap "6px"
-               :align :center
-               :children [[title
-                           :label name
-                           :level :level4]
-                          [md-icon-button
-                           :md-icon-name "zmdi-info"
-                           :tooltip "See online documentation"
-                           :tooltip-position :right-center
-                           :size :smaller
-                           :style {:justify-content :center}
-                           :on-click #(utils/open-new-window (utils/symbol->clojuredocs-url full-name))]]]
-       :body [(fn []
-                [scroller
-                 :size "1 1 auto"
-                 :max-width (str popover-width)
-                 :max-height (str (- popover-height 50))
-                 :scroll :auto
-                 :child [v-box
-                         :size "1 1 auto"
-                         :gap "8px"
-                         :width (str popover-content-width)
-                         :style {:padding "4px"}
-                         :children [(when (not-empty sign)
-                                      [api-signatures sign])
-                                    (when (not-empty desc)
-                                      [api-symbol-description desc])
-                                    (when (not-empty related)
-                                      [api-related-symbols related])
-                                    (when (not-empty examples)
-                                      [api-examples showing-atom examples])]]])]])))
+             examples (map (fn [html string] {:html html :strings string}) examples-htmls examples-strings)
+             popover-width  (if (= :narrow @media-query) 250 400)
+             popover-height (if (= :narrow @media-query) 200 400)
+             popover-content-width (- popover-width (* 2 14) 15)] ; bootstrap padding + scrollbar width
+        [popover-content-wrapper
+         :showing? showing-atom
+         :position @position-atom
+         :on-cancel (handler-fn (reset! showing-atom false))
+         :style {:max-height (str popover-height)
+                 :max-width (str popover-width)}
+         :backdrop-opacity 0.1
+         :close-button? false
+         :title [h-box
+                 :gap "6px"
+                 :align :center
+                 :children [[title
+                             :label name
+                             :level :level4]
+                            [md-icon-button
+                             :md-icon-name "zmdi-info"
+                             :tooltip "See online documentation"
+                             :tooltip-position :right-center
+                             :size :smaller
+                             :style {:justify-content :center}
+                             :on-click #(utils/open-new-window (utils/symbol->clojuredocs-url full-name))]]]
+         :body [(fn []
+                  [scroller
+                   :size "1 1 auto"
+                   :max-width (str popover-width)
+                   :max-height (str (- popover-height 50))
+                   :scroll :auto
+                   :child [v-box
+                           :size "1 1 auto"
+                           :gap "8px"
+                           :width (str popover-content-width)
+                           :style {:padding "4px"}
+                           :children [(when (not-empty sign)
+                                        [api-signatures sign])
+                                      (when (not-empty desc)
+                                        [api-symbol-description desc])
+                                      (when (not-empty related)
+                                        [api-related-symbols related])
+                                      (when (not-empty examples)
+                                        [api-examples showing-atom examples])]]])]]))))

 (defn api-symbol
   "Builds the UI for a single symbol. Will be a button."


Added, but commented out, WebSocket API.

--- src/cljs/clojure/browser/net.cljs
+++ src/cljs/clojure/browser/net.cljs
@@ -137,3 +137,46 @@
                            (assoc sum field v)))
                        {}
                        config)))))
+
+;; WebSocket is not supported in the 3/23/11 release of Google
+;; Closure, but will be included in the next release.
+
+#_(defprotocol IWebSocket
+    (open? [this]))
+
+#_(extend-type goog.net.WebSocket
+
+  IWebSocket
+  (open? [this]
+    (.isOpen this ()))
+
+  IConnection
+  (connect
+    ([this url]
+       (connect this url nil))
+    ([this url protocol]
+       (.open this url protocol)))
+
+  (transmit [this message]
+    (.send this message))
+
+  (close [this]
+    (.close this ()))
+
+  event/EventType
+  (event-types [this]
+    (into {}
+          (map
+           (fn [[k v]]
+             [(keyword (. k (toLowerCase)))
+              v])
+           (merge
+            (js->clj goog.net.WebSocket/EventType))))))
+
+#_(defn websocket-connection
+  ([]
+     (websocket-connection nil nil))
+  ([auto-reconnect?]
+     (websocket-connection auto-reconnect? nil))
+  ([auto-reconnect? next-reconnect-fn]
+     (goog.net.WebSocket. auto-reconnect? next-reconnect-fn)))


Prevent default browser keyboard handler when processing keyboard shortcut

--- src/asciinema/player/view.cljs
+++ src/asciinema/player/view.cljs
@@ -22,7 +22,9 @@
   (fn [dom-event]
     (when-let [msg (f dom-event)]
       (put! ch msg)
-      (.stopPropagation dom-event))))
+      (doto dom-event
+        .stopPropagation
+        .preventDefault))))

 (defn send! [ch msg]
   (send-value! ch (fn [_] msg)))
@@ -259,7 +261,9 @@

 (defn handle-key-press [msg-ch dom-event]
   (when-let [msg (key-press->message dom-event)]
-    (.stopPropagation dom-event)
+    (doto dom-event
+      .stopPropagation
+      .preventDefault)
     (if (= msg :toggle-fullscreen)
       (fullscreen/toggle (.-currentTarget dom-event))
       (put! msg-ch msg))


first working interaction

first working interaction

--- src/cljs/just_married/events.cljs
+++ src/cljs/just_married/events.cljs
@@ -1,3 +1,8 @@
-(ns just-married.events)
+(ns just-married.events
+  (:require [re-frame.core :as re-frame :refer [dispatch reg-event-db]]))

-(def n 10)
+
+(reg-event-db
+ :set-language
+ (fn [db [_ language]]
+   (assoc db :language language)))


C handler: Remove debug middleware

C handler: Remove debug middleware

I had the debug middleware added everywhere. Now everything works (???),
so I don't need it.

--- src/cljs/theatralia/handlers.cljs
+++ src/cljs/theatralia/handlers.cljs
@@ -69,7 +69,7 @@
   [_ [handle]]
   [{:db/id -1
     :kv-area/handle handle}])
-(tsky/register-handler :kv-area/new [middleware/debug] kv-area-new-eh)
+(tsky/register-handler :kv-area/new kv-area-new-eh)

 ;; TODO: Can we use :db.fn/cas? (RM 2015-09-03)
 (defn kv-area-set-eh
@@ -90,25 +90,25 @@
         :kv-cell/val v}
        {:db/id [:kv-area/handle kv-handle]
         :kv-area/cells -1}])))
-(tsky/register-handler :kv-area/set [middleware/debug] kv-area-set-eh)
+(tsky/register-handler :kv-area/set kv-area-set-eh)

 (defn tags-add-empty-eh
   [db [index]]
   [{:db/id -1
     :tag/s-id index
     :tag/text ""}])
-(tsky/register-handler :tags/add-empty [middleware/debug] tags-add-empty-eh)
+(tsky/register-handler :tags/add-empty tags-add-empty-eh)

 (defn tags-remove-eh
   [db [index]]
   [[:db.fn/retractEntity [:tag/s-id index]]])
-(tsky/register-handler :tags/remove [middleware/debug] tags-remove-eh)
+(tsky/register-handler :tags/remove tags-remove-eh)

 (defn tags-set-eh
   [db [index tag]]
   [{:db/id [:tag/s-id index]
     :tag/text tag}])
-(tsky/register-handler :tags/set [middleware/debug] tags-set-eh)
+(tsky/register-handler :tags/set tags-set-eh)

 ;; REFACTOR: Make this a bit more self-documenting. (RM 2015-09-08)
 (defn add-material-submit-eh
@@ -152,4 +152,4 @@
              [?a :kv-area/cells ?c]]
     kv-handle]
    [:db.fn/call retract-entities '[:find [?e ...] :where [?e :tag/s-id _]]]])
-(tsky/register-handler :add-material/success [middleware/debug] add-material-success-eh)
+(tsky/register-handler :add-material/success add-material-success-eh)


Added additional helper functions

Added additional helper functions

--- src/clojure/andylisp/bytecode.clj
+++ src/clojure/andylisp/bytecode.clj
@@ -47,13 +47,77 @@
   [cf e]
     (.getMethods cf))

-(def get-access-flags
-  [cf e]
+(defn get-access-flags
+  [cf]
      (.getAccessFlags cf))

 (defn get-fields
   [cf e]
     (.getFields cf))
+
+(defn public?
+  [cf]
+    (if (> (bit-and (.intValue (get-access-flags cf)) 1) 0)
+      true
+      false))
+
+
+(defn final?
+  [cf]
+    (if (> (bit-and (.intValue (get-access-flags cf)) 2) 0)
+      true
+      false))
+
+(defn super?
+  [cf]
+    (if (> (bit-and (.intValue (get-access-flags cf)) 32) 0)
+      true
+      false))
+
+(defn interface?
+  [cf]
+    (if (> (bit-and (.intValue (get-access-flags cf)) 512) 0)
+      true
+      false))
+
+(defn abstract?
+  [cf]
+    (if (> (bit-and (.intValue (get-access-flags cf)) 1024) 0)
+      true
+      false))
+
+(defn synthetic?
+  [cf]
+    (if (> (bit-and (.intValue (get-access-flags cf)) 4096) 0)
+      true
+      false))
+
+(defn annotation?
+  [cf]
+    (if (> (bit-and (.intValue (get-access-flags cf)) 8192) 0)
+      true
+      false))
+
+(defn enum?
+  [cf]
+    (if (> (bit-and (.intValue (get-access-flags cf)) 16384) 0)
+      true
+      false))
+
+
+(defn get-flags
+  [cf]
+     (into []
+           (keep (partial #(if ((second %2) %1) (first %2))
+                          cf)
+                 [[:public public?]
+                  [:final final?]
+                  [:super super?]
+                  [:interface interface?]
+                  [:abstract abstract?]
+                  [:synthetic synthetic?]
+                  [:annotation annotation?]
+                  [:enum enum?]])))

 (defn -main
   [& args]


[WR] change naming in dev.core

[WR] change naming in dev.core

--- dev-src/dev/core.clj
+++ dev-src/dev/core.clj
@@ -22,12 +22,12 @@
           xml-output/pipeline
           [psql/insert-validations]))

-(defn -main [zip-filename]
+(defn -main [filename]
   (psql/initialize)
-  (let [zip (if (zip/xml-file? zip-filename)
-              (java.nio.file.Paths/get zip-filename (into-array [""]))
-              (java.io.File. zip-filename))
-        result (pipeline/process pipeline zip)]
+  (let [file (if (zip/xml-file? filename)
+               (java.nio.file.Paths/get filename (into-array [""]))
+               (java.io.File. filename))
+        result (pipeline/process pipeline file)]
     (when-let [xml-output-file (:xml-output-file result)]
       (println "XML:" (.toString xml-output-file))
       (let [filename (xml-filename result)


examples of two verbs ("be") and ("see") showing distinction between reflexive and non-reflexive senses

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -184,10 +184,29 @@
              (unify common
                     {:synsem {:cat :verb
                               :sem {:obj obj
+                                    :reflexive false
                                     :pred pred
                                     :shared-with-obj true}
                               :subcat {:1 {:cat :noun}
                                        :2 {:cat :prep
+                                           :reflexive false
+                                           :sem {:obj obj
+                                                 :pred pred}}}}}))
+           (let [pred (atom :top)
+                 obj (atom :top)
+                 agr (atom :top)]
+             (unify common
+                    {:synsem {:cat :verb
+                              :sem {:subj obj ;; reflexive: subj=obj
+                                    :obj obj
+                                    :reflexive true
+                                    :pred pred
+                                    :shared-with-obj true}
+                              :subcat {:1 {:cat :noun
+                                           :agr agr}
+                                       :2 {:cat :prep
+                                           :reflexive true
+                                           :agr agr
                                            :sem {:obj obj
                                                  :pred pred}}}}}))])

@@ -1544,14 +1563,32 @@
    "second" (unify adjective
                    {:synsem {:sem {:mod {:pred :second}
                                    :comparative false}}})
-   "see"  {:synsem {:cat :verb
-                    :sem {:pred :see}
-                    :subcat {:1 {:cat :noun
-                                 :sem {:animate true}}
-                             :2 {:cat :noun
-                                 :sem {:physical-object true}}}}
-           :english {:past "saw"
-                     :past-participle "seen"}}
+   "see"  [{:synsem {:cat :verb
+                     :sem {:pred :see
+                           :reflexive false}
+                     :subcat {:1 {:cat :noun
+                                  :sem {:animate true}}
+                              :2 {:cat :noun
+                                  :reflexive false
+                                  :sem {:physical-object true}}}}
+            :english {:past "saw"
+                      :past-participle "seen"}}
+           (let [obj (atom {:animate true
+                            :physical-object true})
+                 agr (atom :top)]
+             {:synsem {:cat :verb
+                       :sem {:pred :see
+                             :reflexive true}
+                       :subcat {:1 {:cat :noun
+                                    :agr agr
+                                    :sem obj}
+                                :2 {:cat :noun
+                                    :pronoun true
+                                    :agr agr
+                                    :sem obj
+                                    :reflexive true}}}
+              :english {:past "saw"
+                        :past-participle "seen"}})]

    "sell" {:synsem {:cat :verb
                     :sem {:pred :vendere}}


specify which compile-time lexical default rules should apply only to exceptions

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2774,14 +2774,20 @@
                  :subcat {:2 {:subcat '()}}}})

       (default
-       {:synsem {:cat :verb
+       {:english {:exception false}
+        :synsem {:cat :verb}})
+
+      (default
+       {:english {:exception true}
+        :synsem {:cat :verb
                  :aux false
                  :infl :past
                  :sem {:tense :past}}})
-
       (default
-       {:synsem {:cat :verb
+       {:english {:exception true}
+        :synsem {:cat :verb
                  :aux false
+                 :infl :past
                  :sem {:aspect :perfect
                        :tense :past}}})


add terminator for subcat list

add terminator for subcat list

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -197,7 +197,8 @@
                                        :2 {:cat :prep
                                            :reflexive false
                                            :sem {:obj obj
-                                                 :pred pred}}}}}))
+                                                 :pred pred}}
+                                       :3 '()}}}))
            (let [pred (atom :top)
                  obj (atom :top)
                  agr (atom :top)]
@@ -215,7 +216,8 @@
                                            :reflexive true
                                            :agr agr
                                            :sem {:obj obj
-                                                 :pred pred}}}}}))])
+                                                 :pred pred}}
+                                       :3 '()}}}))])

    "be able" (let [common {:english {:imperfect {:1sing "was able"
                                                  :2sing "were able"


add subcategorization for "see"

add subcategorization for "see"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1529,7 +1529,11 @@
                                    :comparative false}}})

    "see"  {:synsem {:cat :verb
-                    :sem {:pred :see}}
+                    :sem {:pred :see}
+                    :subcat {:1 {:cat :noun
+                                 :sem {:animate true}}
+                             :2 {:cat :noun
+                                 :sem {:physical-object true}}}}
            :english {:past "saw"
                      :past-participle "seen"}}


Minor cleanups

Minor cleanups

--- src/riemann/prometheus.clj
+++ src/riemann/prometheus.clj
@@ -30,16 +30,16 @@
 (defn create-label
   "Creates a Prometheus label out of a Riemann event."
   [filtered-event]
-  (-> ""
-      (str/join (->> filtered-event
-                     (map #(if-not (nil? (second %)) (str "/" (name (first %)) "/" (second %))))))))
+  (->> filtered-event
+       (map #(if-not (nil? (second %)) (str "/" (name (first %)) "/" (second %))))
+       (str/join "")))

 (defn filter-event
   "Filter attributes from a Riemann event."
   [event]
-  (-> event
-      (select-keys (->> (keys event)
-                        (filter #(if-not (contains? special-fields %) %))))))
+  (->> (keys event)
+       (filter #(if-not (contains? special-fields %) %))
+       (select-keys event)))

 (defn generate-labels
   "Generates the Prometheus labels from Riemann event attributes."


Fix word-wrap? in wpml

Fix word-wrap? in wpml

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -303,7 +303,7 @@
            mirror-indents?]}]
   ;; Paragraph Properties
   (node :w:pPr {}
-        (when (word-wrap?)
+        (when word-wrap?
           ;; Allow Line Breaking at Character Level
           (node :w:wordWrap {:w:val true}))
         (when (or space-before space-after space-line)


Reformat styles with Cursive

Reformat styles with Cursive

--- src/singularity/style.cljs
+++ src/singularity/style.cljs
@@ -1,6 +1,6 @@
 (ns ^{:doc "Contains styles for the whole application"}
-  singularity.style
-	(:require [garden.core :as garden]
+ singularity.style
+  (:require [garden.core :as garden]
             [garden.selectors :as sel]))

 (def sq-text "#9999aa")
@@ -15,43 +15,35 @@

 (def ^:private inline-block {:display "inline-block" :vertical-align "top"})

-(def css (garden/css
-  [:* { :box-sizing "border-box" }]
-  [:body {
-    :user-select "none"
-    :-moz-user-select "none"
-    :-webkit-user-select "none"
-    :font "14px Calibri,Arial,sans-serif"}]
-  [(keyword "g:nth-child(2n) path") {:fill sq-black}
-    [:&.sel {:fill sq-sel}]
-    [:&.valid:hover {:fill sq-valid}]
-    [:&.invalid:hover {:fill sq-invalid}]]
-  [:path {
-    :fill sq-white
-    :stroke sq-text}
-    [:&.sel {:fill sq-sel}]
-    [:&.valid:hover {:fill sq-valid}]
-    [:&.invalid:hover {:fill sq-invalid}]]
-  [:text {
-    :font-size "20px"
-    :cursor "default"
-    :fill sq-text}]
-  [:#board (into inline-block {
-    :width "600px"
-    :margin "10px"})]
-  [:.panel (into inline-block {
-    :width "150px"})]
-  [:input (into inline-block {
-    :width "30px"
-    :margin "0px 5px"
-    :border "none"
-    :color text-input
-    :background-color sq-white
-    :border-radius "4px"})]
-  [:p (into inline-block {:color text})]
-  [:a.input {
-    :text-decoration "underline"
-    :color text-input
-    :cursor "pointer"}]
-  [:.valid {
-    :background-color "red"}]))+(def css (garden/css
+           [:* {:box-sizing "border-box"}]
+           [:body {:user-select         "none"
+                   :-moz-user-select    "none"
+                   :-webkit-user-select "none"
+                   :font                "14px Calibri,Arial,sans-serif"}]
+           [(keyword "g:nth-child(2n) path") {:fill sq-black}
+            [:&.sel {:fill sq-sel}]
+            [:&.valid:hover {:fill sq-valid}]
+            [:&.invalid:hover {:fill sq-invalid}]]
+           [:path {:fill   sq-white
+                   :stroke sq-text}
+            [:&.sel {:fill sq-sel}]
+            [:&.valid:hover {:fill sq-valid}]
+            [:&.invalid:hover {:fill sq-invalid}]]
+           [:text {:font-size "20px"
+                   :cursor    "default"
+                   :fill      sq-text}]
+           [:#board (into inline-block {:width  "600px"
+                                        :margin "10px"})]
+           [:.panel (into inline-block {:width "150px"})]
+           [:input (into inline-block {:width            "30px"
+                                       :margin           "0px 5px"
+                                       :border           "none"
+                                       :color            text-input
+                                       :background-color sq-white
+                                       :border-radius    "4px"})]
+           [:p (into inline-block {:color text})]
+           [:a.input {:text-decoration "underline"
+                      :color           text-input
+                      :cursor          "pointer"}]
+           [:.valid {:background-color "red"}]))


improve test helper

improve test helper

--- src/clj/elephantdb/testing.clj
+++ src/clj/elephantdb/testing.clj
@@ -179,7 +179,9 @@
 (defn check-domain-pred [domain-name handler pairs pred]
   (doseq [[k v] pairs]
     (let [newv (-> handler (.get domain-name k) (.get_data))]
-      (is (pred v newv) (str (seq k) (seq v) (seq newv)))
+      (if (nil? v)
+        (is (nil? newv))
+        (is (pred v newv) (str (seq k) (seq v) (seq newv))))
       )))

 (defn barr [& vals]


Common db create check

Common db create check

--- src/clj_crud/data/accounts.clj
+++ src/clj_crud/data/accounts.clj
@@ -68,8 +68,7 @@
                                               :admin admin?
                                               :created_at now
                                               :updated_at now})]
-          (debug "Database res: " res)
-          (when-not (contains? (first res) :1)
+          (when-not (= 1 (count res))
             (throw (Exception.  "DB Create has not succeeded")))
           (get-account db (:slug account)))))))


Fix display of selected alias -> namespace mapping after vars-cbx label changed

--- src/clj_ns_browser/browser.clj
+++ src/clj_ns_browser/browser.clj
@@ -759,7 +759,7 @@
       (b/selection (id :vars-lb))
       (b/transform (fn [v]
         (if v
-          (let [fqn (if (= "aliases" (selection (id :vars-cbx)))
+          (let [fqn (if (= "Aliases" (selection (id :vars-cbx)))
                       (when-let [n (get (ns-aliases
                                          (the-ns (symbol
                                                   (selection (id :ns-lb)))))


add some more try this statements in first steps

--- src/cljs_demo/first_steps.cljs
+++ src/cljs_demo/first_steps.cljs
@@ -69,7 +69,9 @@

 `figwheel` is a live hot-code reloading plugin.

-We can edit the clojurescript code (and CSS) and have this element change."
+We can edit the clojurescript code (and CSS) and have this element change.
+
+_Try editing `/src/cljs_demo/first_steps.cljs` and watch this element change._"

   (html [:div [:h2.hello-denverscript
                "Hello World"]]))
@@ -78,7 +80,9 @@
   "# REPL
 ## (Read Evaluate Print Loop)

-Interact with the clojurescript environment and return a result"
+Interact with the clojurescript environment and return a result.
+
+_Try using the repl in `lein figwheel` or `cider` to execute these statements_"

 "```clojure
 (+ 1 2)
@@ -90,6 +94,8 @@
 (defonce repl-demo-state (atom {:text "This is changable" :count 50}))
 (defcard repl-demo
   "# REPL can interact with App
+
+_Try executing these statements in your repl, and watch what happens!_

 ```clojure
 (ns cljs-demo.first-steps)


Added create-child! fn

Added create-child! fn

--- src/clojure/alfresco/nodes.clj
+++ src/clojure/alfresco/nodes.clj
@@ -47,6 +47,11 @@
   (aspects [this] "Provides all the aspect QNames of this node")
   (dir? [this] "True if the node is of type or a subtype of cm:folder")
   (site? [this] "True if the node is of type or a subtype of st:site")
+  (create-child! [this name params] "Creates a new child node. params map may contain:
+    :type - node type. Defaults to cm:content.
+    :props - other properties for the node. Defaults to cm:name=name.
+    :assoc-type - association type. Defaults to cm:contains.
+    :assoc-name - association name. Defaults to name.")
   (create-child-assoc [this propmap] "Creates a new node. Accepts a map containing the following parameters:
    - assoc-type : OPTIONAL - the association type. Defaults to cm:contains
    - assoc : OPTIONAL - the association name. Defaults to the new node cm:name
@@ -117,6 +122,21 @@
   (dir? [node] (= (m/qname ContentModel/TYPE_FOLDER) (.getType (node-service) node)))

   (site? [node] (= (m/qname SiteModel/TYPE_SITE) (.getType (node-service) node)))
+
+  (create-child! [node name params]
+    (let [type        (m/qname (get params :type ContentModel/TYPE_CONTENT))
+          props       (into (zipmap (map m/qname (keys (:props params))) (vals (:props params)))
+                            { ContentModel/PROP_NAME name })  ; Force cm:name to exist in the new node's properties
+          assoc-type  (m/qname (get params :assoc-type ContentModel/ASSOC_CONTAINS))
+          assoc-name  (m/qname (get params :assoc-name name))
+          _           (println "####TEST!!!!\n\tnode =" node "\n\tassoc-type =" assoc-type "\n\tassoc-name =" assoc-name "\n\ttype =" type "\n\tprops =" props)  ; ####TEST!!!
+          child-assoc (.createNode (node-service)
+                                   node
+                                   assoc-type
+                                   assoc-name
+                                   type
+                                   props)]
+      (.getChildRef child-assoc)))

   (create-child-assoc
     [node {:keys [assoc-type assoc props type]}]
@@ -196,6 +216,7 @@
   (aspects [this] nil)
   (dir? [this] nil)
   (site? [this] nil)
+  (create-child! [this name params] nil)
   (create-child-assoc [this propmap] nil)
   (children [this] nil)
   (parent [this] nil)


Fix for issue with try-diff-subseq.

Fix for issue with try-diff-subseq.

--- src/clojure/freactive/dom.cljs
+++ src/clojure/freactive/dom.cljs
@@ -577,19 +577,17 @@

 (defn- try-diff-subseq [parent cur-child new-children]
   (loop [cur-child cur-child
-         new-child (first new-children)
-         more (rest new-children)]
+         [new-child & more :as new-children] new-children]
     (if new-child
       (if cur-child
         (if (and (sequential? new-child) (not (keyword? (first new-child))))
           (let [cur-child (try-diff-subseq parent cur-child new-child)]
-            (recur cur-child (first more) (rest more)))
+            (recur cur-child more))
           (let [next-sib (.-nextSibling cur-child)]
             (replace-child parent new-child cur-child false)
-            (recur next-sib (first more) (rest more))))
+            (recur next-sib more)))
         (do
-          (append-child! parent new-child)
-          (append-children! parent more)
+          (append-children! parent new-children)
           nil))
       cur-child)))


Rewrite `find-view` to support neko.ui's :id trait

--- src/clojure/neko/find_view.clj
+++ src/clojure/neko/find_view.clj
@@ -1,32 +1,10 @@
-; Copyright © 2011 Sattvik Software & Technology Resources, Ltd. Co.
-; All rights reserved.
-;
-; This program and the accompanying materials are made available under the
-; terms of the Eclipse Public License v1.0 which accompanies this distribution,
-; and is available at <http://www.eclipse.org/legal/epl-v10.html>.
-;
-; By using this software in any fashion, you are agreeing to be bound by the
-; terms of this license.  You must not remove this notice, or any other, from
-; this software.
-
 (ns neko.find-view
-  "Home of the ViewFinder protocol, which should simplify and unify use of the
-  findViewById method introduced in various Android classes.  To use the
-  protocol, you need an object that supports findViewById, and these are:
-
-  + activities
-  + dialogs
-  + views
-  + windows
-
-  Given one of these objects, you can (find-view obj id).
-
-  In addition, if within a with-activity form, you can leave out the activity
-  argument, simplifying the above call to:
-
-    (find-view R$id/my_view)"
-  {:author "Daniel Solano Gómez"}
-  (:use neko.activity))
+  "Home of the ViewFinder protocol, which should simplify and unify
+  obtaining UI elements by their :id trait. To use the protocol an
+  object has to keep a mapping of IDs to UI widgets. Currently the
+  protocol is supported by Activity and View objects."
+  (:import android.view.View
+           android.app.Activity))

 (defn- nil-or-view?
   [x]
@@ -34,45 +12,22 @@
       (instance? android.view.View x)))

 (defprotocol ViewFinder
-  "Protocol for finding child views by an ID."
-  (find-view [id] [finder id]
-    "The two-arg version is the general version used outside of any context.
-    The one-arg version is designed for use within a (with-activity)
-    context."))
+  "Protocol for finding child views by their `:id` trait."
+  (find-view [container id]))

 (extend-protocol ViewFinder
-  android.view.Window
-  (find-view [window id]
-    {:pre  [(integer? id)]
-     :post [(nil-or-view? %)]}
-    (.findViewById window id))
+  View
+  (find-view [^View view, id]
+    {:post [(nil-or-view? %)]}
+    (get (.getTag view) id))

-  android.app.Activity
-  (find-view [activity id]
-    {:pre  [(integer? id)]
-     :post [(nil-or-view? %)]}
-    (.findViewById activity id))
+  Activity
+  (find-view [^Activity activity, id]
+    {:post [(nil-or-view? %)]}
+    (get (.. activity getWindow getDecorView getTag) id)))

-  android.view.View
-  (find-view [view id]
-    {:pre  [(integer? id)]
-     :post [(nil-or-view? %)]}
-    (.findViewById view id))
-
-  android.app.Dialog
-  (find-view [dialog id]
-    {:pre  [(integer? id)]
-     :post [(nil-or-view? %)]}
-    (.findViewById dialog id))
-
-  Integer
-  (find-view [id]
-    {:pre [(has-*activity*?)]
-     :post [(nil-or-view? %)]}
-    (find-view *activity* id))
-
-  Long
-  (find-view [id]
-    {:pre [(has-*activity*?)]
-     :post [(nil-or-view? %)]}
-    (find-view *activity* (.intValue id))))
+(defn find-views
+  "Same as `find-view`, but takes a variable number of IDs and returns
+a vector of found views."
+  [container & ids]
+  (map (partial find-view container) ids))


Clean up lein code

Clean up lein code

--- src/clojure/nightcode/lein.clj
+++ src/clojure/nightcode/lein.clj
@@ -6,6 +6,7 @@
             [leiningen.core.project]
             [leiningen.clean]
             [leiningen.cljsbuild]
+            [leiningen.compile]
             [leiningen.droid]
             [leiningen.javac]
             [leiningen.new]
@@ -48,10 +49,10 @@
           (catch Exception e {}))))))

 (defn add-sdk-path
-  [project-map]
-  (assoc-in project-map
+  [project]
+  (assoc-in project
             [:android :sdk-path]
-            (or (get-in project-map [:android :sdk-path])
+            (or (get-in project [:android :sdk-path])
                 (utils/read-pref :android-sdk))))

 (defn create-file-from-template
@@ -62,13 +63,13 @@
            (leiningen.new.templates/->files data)))))

 (defn stale-java-classes
-  [dirs compile-path]
-  (for [dir dirs
+  [project]
+  (for [dir (:java-source-paths project)
         source (filter #(-> % (.getName) (.endsWith ".java"))
                        (file-seq (java.io/file dir)))
         :let [rel-source (.substring (.getPath source) (inc (count dir)))
               rel-compiled (.replaceFirst rel-source "\\.java$" ".class")
-              compiled (java.io/file compile-path rel-compiled)]
+              compiled (java.io/file (:compile-path project) rel-compiled)]
         :when (>= (.lastModified source) (.lastModified compiled))]
     (.getPath compiled)))

@@ -95,16 +96,16 @@

 (defn is-java-project?
   [path]
-  (when-let [project-map (read-project-clj path)]
-    (or (:java-only project-map)
-        (= (count (:source-paths project-map)) 0)
-        (clojure.set/subset? (set (:source-paths project-map))
-                             (set (:java-source-paths project-map))))))
+  (when-let [project (read-project-clj path)]
+    (or (:java-only project)
+        (= (count (:source-paths project)) 0)
+        (clojure.set/subset? (set (:source-paths project))
+                             (set (:java-source-paths project))))))

 (defn is-clojurescript-project?
   [path]
-  (when-let [project-map (read-project-clj path)]
-    (not (nil? (:cljsbuild project-map)))))
+  (when-let [project (read-project-clj path)]
+    (not (nil? (:cljsbuild project)))))

 ; start/stop thread/processes

@@ -153,8 +154,8 @@

 (defn start-process-indirectly
   [process path & args]
-  (let [project-map (read-project-clj path)
-        java-cmd (or (:java-cmd project-map) (System/getenv "JAVA_CMD") "java")
+  (let [project (read-project-clj path)
+        java-cmd (or (:java-cmd project) (System/getenv "JAVA_CMD") "java")
         jar-file (-> (Class/forName class-name)
                      .getProtectionDomain
                      .getCodeSource
@@ -172,24 +173,24 @@

 (defn start-process-directly
   [process path func]
-  (let [project-map-orig (read-project-clj path)
-        jvm-opts (conj (:jvm-opts project-map-orig)
+  (let [project-orig (read-project-clj path)
+        jvm-opts (conj (:jvm-opts project-orig)
                        (str "-agentlib:jdwp="
                             "transport=dt_socket,"
                             "server=y,"
                             "suspend=n,"
                             "address="
                             debug-port))
-        project-map (-> project-map-orig
-                        (assoc :eval-in :trampoline
-                               :jvm-opts jvm-opts))
+        project (-> project-orig
+                    (assoc :eval-in :trampoline
+                           :jvm-opts jvm-opts))
         forms leiningen.core.eval/trampoline-forms
         profiles leiningen.core.eval/trampoline-profiles]
     (reset! forms [])
     (reset! profiles [])
-    (func path project-map)
+    (func path project)
     (doseq [i (range (count @forms))]
-      (->> (leiningen.core.eval/shell-command project-map (nth @forms i))
+      (->> (leiningen.core.eval/shell-command project (nth @forms i))
            (start-process process path)))))

 (defn stop-process
@@ -201,54 +202,52 @@
 ; low-level commands

 (defn run-project-task
-  [path project-map]
+  [path project]
   (if (is-android-project? path)
     (doseq [sub-cmd ["build" "apk" "install" "run"]]
-      (leiningen.droid/droid (add-sdk-path project-map) sub-cmd))
-    (leiningen.run/run project-map)))
+      (leiningen.droid/droid (add-sdk-path project) sub-cmd))
+    (leiningen.run/run project)))

 (defn run-repl-project-task
-  [path project-map]
+  [path project]
   (if (is-android-project? path)
     (doseq [sub-cmd ["doall" "repl"]]
-      (leiningen.droid/droid (add-sdk-path project-map) sub-cmd)
+      (leiningen.droid/droid (add-sdk-path project) sub-cmd)
       (Thread/sleep 10000))
-    (leiningen.repl/repl project-map)))
+    (leiningen.repl/repl project)))

 (defn build-project-task
-  [path project-map]
+  [path project]
   (if (is-android-project? path)
-    (-> (leiningen.droid/transform-into-release project-map)
+    (-> (leiningen.droid/transform-into-release project)
         add-sdk-path
         leiningen.droid/execute-release-routine)
-    (leiningen.uberjar/uberjar project-map)))
+    (leiningen.uberjar/uberjar project)))

 (defn test-project-task
-  [path project-map]
-  (leiningen.test/test project-map))
+  [path project]
+  (leiningen.test/test project))

 (defn clean-project-task
-  [path project-map]
-  (leiningen.clean/clean project-map))
+  [path project]
+  (leiningen.clean/clean project))

 (defn cljsbuild-project-task
-  [path project-map]
-  (leiningen.cljsbuild/cljsbuild project-map "auto"))
+  [path project]
+  (leiningen.cljsbuild/cljsbuild project "auto"))

 (defn hot-swap-project-task
-  [path project-map]
+  [path project]
   (when-let [conn (->> (Bootstrap/virtualMachineManager)
                        .attachingConnectors
                        (filter #(= (.name (.transport %)) "dt_socket"))
                        first)]
      (let [prm (.defaultArguments conn)
-           stale-classes (-> (:java-source-paths project-map)
-                             (stale-java-classes (:compile-path project-map))
-                             doall)]
+           stale-classes (doall (stale-java-classes project))]
        (.setValue (.get prm "port") debug-port)
        (.setValue (.get prm "hostname") "127.0.0.1")
        (when-let [vm (try (.attach conn prm) (catch Exception _))]
-         (leiningen.javac/javac project-map)
+         (leiningen.javac/javac project)
          (->> stale-classes
               (create-class-map (.allClasses vm))
               (.redefineClasses vm))
@@ -349,14 +348,14 @@
   [cmd & args]
   (System/setProperty "jline.terminal" "dumb")
   (let [path "."
-        project-map (-> (read-project-clj path)
-                        leiningen.core.project/init-project)]
+        project (-> (read-project-clj path)
+                    leiningen.core.project/init-project)]
     (case cmd
-      "run" (run-project-task path project-map)
-      "repl" (run-repl-project-task path project-map)
-      "build" (build-project-task path project-map)
-      "test" (test-project-task path project-map)
-      "clean" (clean-project-task path project-map)
-      "cljsbuild" (cljsbuild-project-task path project-map)
+      "run" (run-project-task path project)
+      "repl" (run-repl-project-task path project)
+      "build" (build-project-task path project)
+      "test" (test-project-task path project)
+      "clean" (clean-project-task path project)
+      "cljsbuild" (cljsbuild-project-task path project)
       nil))
   (System/exit 0))


Solved 4Clojure problem 60 - Sequence Reductions

--- src/clojureplayground/core.clj
+++ src/clojureplayground/core.clj
@@ -62,8 +62,13 @@
        (= x (reduce + fcrs))))) 8128)

 ;Problem 60 - Sequence reductions
-(defn seq-reds
+(defn my-reds
   ([f xs]
-   (loop [in-xs xs z (f) reds-acc []]
-     (when in-xs (lazy-seq ))))
-  ([f z xs]))+   (lazy-seq
+     (my-reds f (first xs) (rest xs))))
+  ([f i xs]
+   (cons i
+     (lazy-seq
+       (when (seq xs)
+         (my-reds f (f i (first xs)) (rest xs)))))))
+


Experimental: adding exploration with incomplete counterexamples

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/fca/exploration.clj
+++ src/conexp/fca/exploration.clj
@@ -16,9 +16,55 @@
 (ns-doc
  "Provides function for exploration and computing proper premises.")

-;;; Attribute Exploration
-
-(declare default-handler)
+;;; Handler for Expert Interaction
+
+(defnk make-handler
+  "Creates a handler for attribute exploration. Valid keys are
+
+  - automorphisms: A sequence of automorphisms of the overall context,
+    used to construct more examples from a given one.
+
+    Currently, this has only an effect if the counterexamples are complete.
+
+  - incomplete-counterexamples?: If true, allows for incomplete counterexamples.  In
+    contrast to the case of complete counterexamples, the function returned takes four
+    arguments (instead of 3), namely the context of the possible incidence, the context of
+    the certain incidence, the known implications aas well as the current implication to
+    be asked to the expert."
+  [:automorphisms #{}, :incomplete-counterexamples? false]
+  (assert (or (set? automorphisms) (seq? automorphisms)))
+  (assert (or (contains? #{true false} incomplete-counterexamples?)))
+  (if incomplete-counterexamples?
+    ;; case of incomplete counterexamples
+    (fn [possible-ctx certain-ctx known impl]
+      (when-not (yes-or-no? (str "Does the implication " (print-str impl) " hold? "))
+        (loop [counterexamples []]
+          (let [counterexamples (conj counterexamples
+                                      (incomplete-counterexample-via-repl possible-ctx
+                                                                          certain-ctx
+                                                                          known
+                                                                          impl))]
+            (if (yes-or-no? "Do you want to give another counterexample? ")
+              (recur counterexamples)
+              counterexamples)))))
+    ;; case of complete counterexamples
+    (fn [ctx known impl]
+      (when-not (yes-or-no? (str "Does the implication " (print-str impl) " hold? "))
+        (loop [counterexamples []]
+          (let [counterexample (counterexample-via-repl ctx known impl),
+                new-counters   (into counterexamples
+                                     (examples-by-automorphism ctx counterexample automorphisms))]
+            (if (yes-or-no? "Do you want to give another counterexample? ")
+              (recur new-counters)
+              new-counters)))))))
+
+;;; Attribute Exploration with Complete Counterexamples
+
+(let [dh (make-handler)]
+  (defn default-handler
+    "Default handler for attribute exploration. Does it's interaction on the console."
+    [ctx known impl]
+    (dh ctx known impl)))

 (defnk explore-attributes
   "Performs attribute exploration in given context. Returns a hashmap
@@ -68,8 +114,8 @@
                                     :abort))]
             (cond
              (= counterexamples :abort)
-             (recur implications nil ctx) ;; forget all other sets
-             ;;;
+             (recur implications nil ctx) ; forget all other sets
+             ;;
              counterexamples
              (let [new-objs (map first counterexamples)]
                ;; check that new names are not there already
@@ -83,39 +129,130 @@
                                     (union (incidence ctx)
                                            (set-of [g m] [[g ms] counterexamples,
                                                           m ms])))))
-             ;;;
-             true
-             ;; add counterexample
+             ;;
+             true                       ; add counterexample
              (recur (conj implications new-impl)
                     (next-closed-set (attributes ctx)
                                      (clop-by-implications (conj implications new-impl))
                                      last)
                     ctx))))))))

-;;; Handler
-
-(defnk make-handler
-  "Creates a handler for attribute exploration. Valid keys are
-
-  - automorphisms: A sequence of automorphisms of the overall context,
-      used to construct more examples from a given one."
-  [:automorphisms #{}]
-  (assert (or (set? automorphisms) (seq? automorphisms)))
-  (fn [ctx known impl]
-    (when-not (yes-or-no? (str "Does the implication " (print-str impl) " hold? "))
-      (loop [counterexamples []]
-        (let [counterexample (counterexample-via-repl ctx known impl),
-              new-counters   (into counterexamples
-                                   (examples-by-automorphism ctx counterexample automorphisms))]
-          (if (yes-or-no? "Do you want to give another counterexample? ")
-            (recur new-counters)
-            new-counters))))))
-
-(let [dh (make-handler)]
-  (defn default-handler
-    "Default handler for attribute exploration. Does it's interaction on the console."
-    [ctx known impl]
-    (dh ctx known impl)))
+;;; Attribute Exploration with Incomplete Counterexamples
+
+(let [dh (make-handler :incomplete-counterexamples? true)]
+  (defn default-handler-for-incomplete-counterexamples
+    "Default handler for attribute exploration with incomplete counterexamples. Does it's
+    interaction on the console."
+    [possible-ctx certain-ctx known impl]
+    (dh possible-ctx certain-ctx known impl)))
+
+(defnk explore-attributes-with-incomplete-counterexamples
+  "EXPERIMENTAL and LARGLY UNTESTED — USE WITH CARE
+
+  Performs attribute exploration in given contexts of possible («possible-ctx») and
+  certain («certain-ctx») incidences, allowing the expert to provide incomplete
+  counterexamples.  Returns a hashmap of implications computed and the final context,
+  stored with keys :implications and :context, respectively.
+
+  The function takes a number of keyword arguments, which are as follows:
+
+  - :handler «fn»
+
+    Interaction is accomplished via the given handler fn, which is called
+    with the current context of possible incidences, the current context of
+    certain indcidences, all implications known so far and a new
+    implication. The handler has to return counterexamples for the new
+    implication, if there are some. Otherwise it has to return
+    nil. Counterexamples are given as a sequence of rows, every row being
+    of the form
+
+       [g positive-attributes negative-attributes],
+
+    where «g» is a new object, «positive-attributes» is a sequence of
+    attributes the new object has, and «negative-attributes» is a sequence
+    of attributes the new object does not have.  Note that
+    «positive-attributes» and «negative-attributes» must be disjoint.
+
+  - :background-knowledge «set of implications»
+
+    background-knowledge denotes a set of implications used as
+    background knowledge, which will be subtracted from the computed
+    result.
+
+  If you want to use automorphisms of the underlying context, you have
+  to construct a special handler using the «make-handler»
+  function. See the corresponding documentation of «make-handler»."
+  [possible-ctx, certain-ctx,
+   :background-knowledge #{},
+   :handler default-handler-for-incomplete-counterexamples]
+  (assert (set? background-knowledge))
+  (assert (= (attributes certain-ctx)
+             (attributes possible-ctx))
+          "Given contexts must coincide on the set of attributes")
+  (assert (= (objects certain-ctx)
+             (objects possible-ctx))
+          "Given contexts must coincide on the set of objects")
+  (loop [implications background-knowledge,
+         last         (close-under-implications implications #{}),
+         possible-ctx possible-ctx
+         certain-ctx  certain-ctx]
+    (if (not last)
+      {:implications (difference implications background-knowledge),
+       :possible-context possible-ctx
+       :certain-context  certain-ctx}
+      (let [conclusion-from-last (oprime possible-ctx (aprime certain-ctx last))] ; ?
+        (if (= last conclusion-from-last)
+          (recur implications
+                 (next-closed-set (attributes possible-ctx)
+                                  (clop-by-implications implications)
+                                  last)
+                 possible-ctx
+                 certain-ctx)
+          (let [new-impl        (make-implication last conclusion-from-last),
+                counterexamples (try
+                                  (handler possible-ctx certain-ctx implications new-impl)
+                                  (catch Throwable e
+                                    :abort))]
+
+            (cond
+             (= counterexamples :abort)
+             (recur implications nil possible-ctx certain-ctx) ; abort exploration
+             ;;
+             counterexamples            ; add counterexample
+             (let [new-objs (map first counterexamples)]
+               ;; check that new names are not there already
+               (when (exists [g new-objs] (contains? (objects possible-ctx) g))
+                 (illegal-argument "Got objects as «new objects» in exploration "
+                                   "which are already present."))
+               (recur implications
+                      last
+                      ;; possible incidence, i.e. the one not excluded by the expert
+                      (make-context (into (objects possible-ctx) new-objs)
+                                    (attributes possible-ctx)
+                                    (union (incidence possible-ctx)
+                                           (set-of [g m] | [g _ neg] counterexamples
+                                                           m (difference (attributes possible-ctx)
+                                                                         (set neg)))))
+                      ;; certain incidence, i.e. the one given by the expert
+                      (make-context (into (objects certain-ctx) new-objs)
+                                    (attributes certain-ctx)
+                                    (union (incidence certain-ctx)
+                                           (set-of [g m] [[g pos _] counterexamples,
+                                                          m pos])))))
+             ;;
+             true                       ; add implication
+             (let [new-implications (conj implications new-impl)]
+               (recur new-implications
+                      (next-closed-set (attributes possible-ctx)
+                                       (clop-by-implications new-implications)
+                                       last)
+                      possible-ctx
+                      (make-context (objects certain-ctx)
+                                    (attributes certain-ctx)
+                                    (set-of [g m] | g (objects certain-ctx)
+                                                    m (close-under-implications
+                                                       new-implications
+                                                       (oprime certain-ctx #{g})))))))))))))

 ;;;


good so far

good so far

--- test/epicea/utils/access_test.clj
+++ test/epicea/utils/access_test.clj
@@ -42,16 +42,17 @@
   (is (= [nil 3 nil nil] (setx default-vec sec 3)))
   (is (= [nil 4 nil nil] (updatex [nil 3 nil nil] sec inc))))

-(comment
   (def x (map-accessor :x))
 (def y (map-accessor :y))
 (def make-xy (constructor {} [x y]))
+

 (deftest constructor-test
   (is (= {:x 3 :y 4} (make-xy 3 4))))

-(def empty-xy2 [nil nil])
+(comment
+  (def empty-xy2 [nil nil])
 (def x2 (vector-accessor 0 {:default-parent empty-xy2}))
 (def y2 (vector-accessor 1 {:default-parent empty-xy2}))
 (def make-xy2 (constructor [x2 y2]))


Move Teensy holder away from edge

Move Teensy holder away from edge

--- src/dactyl_keyboard/dactyl.clj
+++ src/dactyl_keyboard/dactyl.clj
@@ -13,8 +13,8 @@
 ;; Shape parameters ;;
 ;;;;;;;;;;;;;;;;;;;;;;

-(def nrows 4)
-(def ncols 5)
+(def nrows 5)
+(def ncols 6)

 (def α (/ π 12))                        ; curvature of the columns
 (def β (/ π 36))                        ; curvature of the rows
@@ -596,18 +596,16 @@
 (def teensy-height 12)
 (def teensy-length 33)
 (def teensy2-length 53)
-(def teensy-pcb-thickness 1.6)
+(def teensy-pcb-thickness 2)
 (def teensy-holder-width  (+ 7 teensy-pcb-thickness))
 (def teensy-holder-height (+ 6 teensy-width))
 (def teensy-offset-height 5)
-(def teensy-holder-length 72)
+(def teensy-holder-top-length 18)
+(def teensy-top-xy (key-position 0 (- centerrow 1) (wall-locate3 -1 0)))
+(def teensy-bot-xy (key-position 0 (+ centerrow 1) (wall-locate3 -1 0)))
+(def teensy-holder-length (- (second teensy-top-xy) (second teensy-bot-xy)))
 (def teensy-holder-offset (/ teensy-holder-length -2))
-(def teensy-holder-top-length 18)
-(def teensy-top-xy (key-position 0 0 (map + (wall-locate3  0 1) [(/ mount-width -2) (/ mount-height  2) 0])))
-(def teensy-bot-xy (map + (key-position 0 2 (map + (wall-locate3 -1 0) [(/ mount-width -2)  (/ mount-height  2) 0]))
-                          [(* 1 teensy-holder-width) 0 0]))
-(def teensy-holder-top-offset (/ teensy-holder-top-length -2))
-(def teensy-holder-angle (Math/atan2 (- (first teensy-top-xy) (first teensy-bot-xy)) (- (second teensy-top-xy) (second teensy-bot-xy))))
+(def teensy-holder-top-offset (- (/ teensy-holder-top-length 2) teensy-holder-length))

 (def teensy-holder
     (->>
@@ -621,11 +619,9 @@
           (->> (cube teensy-pcb-thickness teensy-holder-top-length 3)
                (translate [(+ (/ teensy-pcb-thickness 2) 3) teensy-holder-top-offset (+ 1.5 (/ teensy-width 2))]))
           (->> (cube 4 teensy-holder-top-length 4)
-               (translate [(+ teensy-pcb-thickness 5) teensy-holder-top-offset (+ 1 (/ teensy-width 2))]))
-          (->> (cube teensy-holder-width 2 teensy-holder-height)
-               (translate [(+ (/ teensy-holder-width 2)) -1 0])))
+               (translate [(+ teensy-pcb-thickness 5) teensy-holder-top-offset (+ 1 (/ teensy-width 2))])))
         (translate [(- teensy-holder-width) 0 0])
-        (rotate teensy-holder-angle [0 0 -1])
+        (translate [(- 1) 0 0])
         (translate [(first teensy-top-xy)
                     (- (second teensy-top-xy) 1)
                     (/ (+ 6 teensy-width) 2)])
@@ -634,7 +630,6 @@
 (def usb-cutout
   (->> (cube 8 30 12)
        (translate [-4 -5 0])
-       (rotate teensy-holder-angle [0 0 -1])
        (translate [(+ (first teensy-top-xy) 3)
                    (+ (second teensy-top-xy) 0)
                    (/ teensy-holder-height 2)])
@@ -643,7 +638,6 @@
 (def teensy-holder-hole
   (->> (cube teensy-holder-width 30 teensy-holder-height)
        (translate [(/ teensy-holder-width -2) -15 (/ teensy-holder-height 2)])
-       (rotate teensy-holder-angle [0 0 -1])
        (translate [(first teensy-top-xy)
                    (- (second teensy-top-xy) 1)
                    0])))
@@ -686,7 +680,6 @@
    (->> shape
         (rotate (/ π 2) [0 -1 0])
         (translate [(- 3 teensy-holder-width (/ screw-insert-height 2)) (- (+ length 7)) 0])
-        (rotate teensy-holder-angle [0 0 -1])
         (translate [(first teensy-top-xy) (second teensy-top-xy) 15])
         )))

@@ -763,7 +756,8 @@
                     case-walls
                     thumbcaps
                     caps
-                    ; teensy-holder
+                    teensy-holder
+                    rj9-holder
                     ; ; teensy-holder-hole
                     ;             screw-insert-outers
                     ;             teensy-screw-insert-holes


Document string formatting

Document string formatting

--- src/degasolv/resolver_core.clj
+++ src/degasolv/resolver_core.clj
@@ -299,10 +299,12 @@
       pkg-list)))

 (defn vet-candidate
-  "Takes a candidate package which has been chosen in hopes of fulfilling a
+  "
+  Takes a candidate package which has been chosen in hopes of fulfilling a
   requirement and ensures that:
   1) It does not violate any 'ensure absent' specifications and
-  2) It fulfills the particular 'ensure present' spec."
+  2) It fulfills the particular 'ensure present' spec.
+  "
   [id-absent-specs safe-spec-call spec candidate]
   (and
     (safe-spec-call spec candidate)
@@ -318,7 +320,9 @@
       id-absent-specs)))

 (defn seek-package
-  "Seek a package from a repository meeting the specs given."
+  "
+  Seek a package from a repository meeting the specs given.
+  "
   [query-results vet]
     (if (empty? query-results)
       [:unsuccessful
@@ -354,12 +358,12 @@
         :suggestions
         suggestions})]))

-
-
 (defn merge-failure-records
-  "Merge two different resolution failure records.
-   Merge using ``(merge-with into ...)`` for everything but suggestions;
-   within the suggestions, merge using ``(merge-with set/intersection ...)``."
+  "
+  Merge two different resolution failure records.
+  Merge using ``(merge-with into ...)`` for everything but suggestions;
+  within the suggestions, merge using ``(merge-with set/intersection ...)``.
+  "
   [a b]
   (let [base-answer (merge-with
                       into


Adding a commented snippet for posterity

--- test/funimage/test/imagej/ops.clj
+++ test/funimage/test/imagej/ops.clj
@@ -8,4 +8,13 @@
 #_(let [fi (net.imglib2.FinalInterval. (long-array [10 10]))
        tpe (net.imglib2.type.numeric.real.DoubleType.)
        img1 (ops/create-img-CreateImgFromDimsAndType fi tpe)]
-   (show-imp (img->imp img1)))
+   (show-imp (img->imp (ops/math-add-ConstantToArrayImage-AddInt img1 17))))
+
+#_(let [cat (imp->img (open-imp "/Users/kharrington/git/funimage/black_cat.tif"))
+       hat (imp->img (open-imp "/Users/kharrington/git/funimage/witch_hat_small.tif"))
+       shape (net.imglib2.algorithm.neighborhood.RectangleShape. 3 false)
+       adder (fn [img1 img2] (imp-flatten (add-overlay-image (copy-imp (img->imp img1)) (img->imp img2) 110 50 100 true)))]
+   (show-imp (tile-imps
+               (map (fn [func] (adder cat (func (img/copy hat) shape)))
+                    [ops/morphology-dilate-DefaultDilate ops/morphology-erode-DefaultErode]))))
+


Implement a gate hold time

Implement a gate hold time

--- src/main/audio_utils/gate.cljs
+++ src/main/audio_utils/gate.cljs
@@ -1,7 +1,7 @@
 (ns audio-utils.gate
   (:require [audio-utils.ring-buffer :as rb]
             [audio-utils.rms-buffer :as rms]
-            [audio-utils.util :refer [aatom aderef areset! aswap!
+            [audio-utils.util :refer [aatom << >> aswap!
                                       db->amplitude time->samples]]
             [audio-utils.worker :as w]))

@@ -27,7 +27,7 @@
   (queue-in-buffer [this channel sample])
   (dequeue-from-buffer [this channel]))

-(defrecord Gate [config next buffers rms-buffers]
+(defrecord Gate [config next buffers rms-buffers samples-held]
   w/IWorkerAudioNode
   (connect [this destination]
     (reset! next destination))
@@ -51,34 +51,39 @@
   (generate-output-sample [this channel input-sample]
     (queue-in-buffer this channel input-sample)
     (add-to-rms this channel input-sample)
-    (let [threshold (db->amplitude (:threshold config))]
+    (let [threshold (db->amplitude (:threshold config))
+          hold      (time->samples (:hold config) (:sample-rate config))]
       (if (>= (calculate-rms this channel) threshold)
-        (dequeue-from-buffer this channel)
-        0.0)))
+        (do
+          (>> samples-held 0)
+          (dequeue-from-buffer this channel))
+        (if (<= (<< samples-held) hold)
+          (do
+            (aswap! samples-held inc)
+            input-sample)
+          0.0))))

   (add-to-rms [this channel sample]
     (aswap! rms-buffers update channel
             (fn [buffer]
-              (let [window (max (time->samples (:rms-window config)
-                                               (:sample-rate config))
-                                2)
+              (let [window (max 2 (time->samples (:rms-window config)
+                                                 (:sample-rate config)))
                     buffer (or buffer (rms/rms-buffer window))]
                 (rms/rms-push buffer sample)))))

   (calculate-rms [this channel]
-    (rms/rms ((aderef rms-buffers) channel)))
+    (rms/rms ((<< rms-buffers) channel)))

   (queue-in-buffer [this channel sample]
     (aswap! buffers update channel
             (fn [buffer]
-              (let [size   (max (time->samples (:look-ahead config)
-                                               (:sample-rate config))
-                                2)
+              (let [size   (max 2 (time->samples (:look-ahead config)
+                                                 (:sample-rate config)))
                     buffer (or buffer (rb/ring-buffer size))]
                 (conj buffer sample)))))

   (dequeue-from-buffer [this channel]
-    (let [buffer ((aderef buffers) channel)
+    (let [buffer ((<< buffers) channel)
           sample (peek buffer)]
       (pop buffer)
       sample)))
@@ -100,13 +105,14 @@
            hold        100
            rms-window  100
            trigger     default-trigger}}]
-  (let [config {:sample-rate sample-rate
-                :threshold   threshold
-                :look-ahead  look-ahead
-                :hold        hold
-                :rms-window  rms-window
-                :trigger     trigger}]
-    (map->Gate {:config      config
-                :next        (atom nil)
-                :buffers     (aatom {})
-                :rms-buffers (aatom {})})))
+  (let [config {:sample-rate  sample-rate
+                :threshold    threshold
+                :look-ahead   look-ahead
+                :hold         hold
+                :rms-window   rms-window
+                :trigger      trigger}]
+    (map->Gate {:config       config
+                :next         (atom nil)
+                :buffers      (aatom {})
+                :rms-buffers  (aatom {})
+                :samples-held (aatom 0)})))


the default compiler environment should always include empty cljs.user namespace. This fixes long outstanding issues where there would be a missing namespace if the current-ns was cljs.user. Also necessary prep work for CLJS-1277.

--- src/main/clojure/cljs/env.cljc
+++ src/main/clojure/cljs/env.cljc
@@ -41,7 +41,8 @@
 (defn default-compiler-env
   ([] (default-compiler-env {}))
   ([options]
-     (atom (merge {:options options}
+     (atom (merge {:cljs.analyzer/namespaces {'cljs.user {:name 'cljs.user}}
+                   :options options}
              #?(:clj {:js-dependency-index (js-dependency-index options)})))))

 #?(:clj


Some styling and refactoring

Some styling and refactoring

--- src/mobile_patient/routes.cljs
+++ src/mobile_patient/routes.cljs
@@ -22,26 +22,17 @@

 (defn add-chat-button [navigation]
   [ui/touchable-highlight {:on-press #(navigation.navigate "Contacts")
-                           :style {:margin-right 20}}
+                           :style {:margin-right 20}
+                           :underlay-color color/grey}
    [ui/icon {:name "add-circle" :size 36 :color color/pink}]])

 ;; NAVIGATION ROUTES

 (defn menu-button [navigation]
   [ui/touchable-highlight {:style {:margin-left 10}
-                           :on-press #(navigation.navigate "DrawerOpen")}
+                           :on-press #(navigation.navigate "DrawerOpen")
+                           :underlay-color color/grey}
    [ui/icon {:name "menu" :size 36 :color color/grey}]])
-
-(defn drawer-nav-button []
-  [ui/touchable-opacity
-   [ui/view {:style {:flexDirection :row
-                     :height 50
-                     :paddingLeft 15
-                     :backgroundColor "#fff0"
-                     :borderTopWidth 0.5
-                     :borderColor "#fff"}}
-    [ui/text {:style {:fontSize 36
-                      :color "#fff"}} "Name"]]])

 (defn drawer-item
   ([title on-press]
@@ -57,14 +48,7 @@

 (defn drawer-content [props]
   (let [user-id @(rf/subscribe [:user-id])
-        excluded #{"About App"}
-        filter-items (fn [props]
-                       (let [clj-props (js->clj props)
-                             excluded #{"About App"}]
-                         (clj->js
-                          (merge clj-props
-                                 {"items" (remove #(excluded (% "key"))
-                                                  (clj-props "items"))}))))]
+        excluded #{"About App"}]
     [ui/view {:style {:background-color "#f4f4f4"
                       :flex 1}}
      [ui/view {:style {:background-color "white"
@@ -94,6 +78,13 @@
   (r/reactify-component
    (StackNavigator (clj->js routes)
                    (clj->js {:headerTitleStyle {:fontWeight :normal}}))))
+
+(defn stack-navigator-back-button [props]
+  (r/as-element
+   [ui/touchable-highlight {:on-press #(props.navigation.goBack nil)
+                            :style {:margin-left 15}
+                            :underlay-color color/grey}
+    [ui/icon {:name "chevron-left" :size 36 :color color/pink}]]))

 (defn drawer-nav-opts
   ([title]
@@ -126,13 +117,17 @@
                                 (fn [props]
                                   (let [chat-name (-> props .-navigation .-state .-params (aget "chat-name"))]
                                     #js {:title chat-name
+                                         :headerLeft (stack-navigator-back-button props)
                                          :headerTitleStyle #js{:fontWeight "normal"
                                                                :color "#6e6e6e"}}))}

                         "Contacts" {:screen (r/reactify-component ContactsScreen)
-                                    :navigationOptions {:title "Contacts"
-                                                        :headerTitleStyle #js{:fontWeight "normal"
-                                                                              :color "#6e6e6e"}}}})}
+                                    :navigationOptions
+                                    (fn [props]
+                                      #js{:title "Contacts"
+                                          :headerLeft (stack-navigator-back-button props)
+                                          :headerTitleStyle #js{:fontWeight "normal"
+                                                                :color "#6e6e6e"}})}})}

      "Settings" {:screen (stack-navigator
                           {"Settings" {:screen (r/reactify-component SettingsScreen)


Changed physliang-experimental to run DemoRuntime

--- src/physilang/experimental.clj
+++ src/physilang/experimental.clj
@@ -1,5 +1,5 @@
 (ns physilang.experimental)

-(import [edu.hsc.hypower.physicloud PhysiCloudRuntime])
+(import [edu.hsc.hypower DemoRuntime])

-(def pc-runtime (new PhysiCloudRuntime "test"))+(def pc-runtime (new DemoRuntime "test"))


(maint) Fix release for final versions

(maint) Fix release for final versions

The method to determine the release number was correctly setting the
release for SNAPSHOT builds but was errantly setting it to the version
if this was not a SNAPSHOT build. This fixes that method to return 1 for
non-SNAPSHOT builds, since we don't support custom release numbers.

--- src/puppetlabs/ezbake/core.clj
+++ src/puppetlabs/ezbake/core.clj
@@ -459,7 +459,7 @@
     (format "%s.%s"
             (str/replace lein-version #".*-" "0.1")
             (get-timestamp-string))
-    lein-version))
+    "1"))

 ;; TODO: this is a horrible, horrible hack; I can't yet see a good way to
 ;; let the packaging library know what the version number is without faking


Update chunker to operate on JS arrays/data

--- src/main/audio_utils/chunker.cljs
+++ src/main/audio_utils/chunker.cljs
@@ -1,5 +1,6 @@
 (ns audio-utils.chunker
-  (:require [audio-utils.worker :as w]))
+  (:require [audio-utils.util :as u]
+            [audio-utils.worker :as w]))

 (defprotocol IChunker
   (process-samples [this samples])
@@ -15,31 +16,35 @@
     (reset! next nil))

   (process-audio [this data]
-    (let [n-channels (count data)
-          n-samples  (count (first data))]
+    (let [n-channels (u/acount data)
+          n-samples  (u/acount (u/afirst data))]
       (dotimes [n n-samples]
-        (let [samples (mapv #(nth % n) data)]
+        (let [samples (u/amap #(u/anth % n) data)]
           (process-samples this samples)))))

   IChunker
   (process-samples [this samples]
-    (dotimes [channel (count samples)]
-      (let [sample (samples channel)]
-        (swap! chunks update channel conj sample)))
-    (when (>= (count (first @chunks)) samples-per-chunk)
+    (dotimes [channel (u/acount samples)]
+      (let [sample (u/anth samples channel)]
+        (u/aswap! chunks u/aupdate channel
+                  (fn [arr]
+                    (doto (or arr (array))
+                      (u/aconj sample))))))
+    (when (>= (u/acount (u/afirst (u/<< chunks)))
+              samples-per-chunk)
       (deliver-chunks this)
-      (reset-chunks this (count samples))))
+      (reset-chunks this (u/acount samples))))

   (deliver-chunks [this]
-    (some-> @next (w/process-audio @chunks)))
+    (some-> @next (w/process-audio (u/<< chunks))))

   (reset-chunks [this n-channels]
-    (let [empty-chunks (into [] (repeat n-channels []))]
-      (reset! chunks empty-chunks))))
+    (let [empty-chunks (into-array (repeat n-channels #js []))]
+      (u/areset! chunks empty-chunks))))

 (defn chunker
   [{:keys [samples-per-chunk]
     :or {samples-per-chunk 4410}}]
   (map->Chunker {:samples-per-chunk samples-per-chunk
                  :next              (atom nil)
-                 :chunks            (atom [])}))
+                 :chunks            (u/aatom #js [])}))


GAWB-2298: Hide previews for common image file types (#901)

* hide previews for common image file types

--- src/cljs/main/broadfcui/common/gcs_file_preview.cljs
+++ src/cljs/main/broadfcui/common/gcs_file_preview.cljs
@@ -28,19 +28,21 @@
                         [:div {:style {:display "inline-block" :width 185}} (str label ": ")]
                         contents])
              data-empty (or (= data-size "0") (string/blank? data-size))
-             bam? (re-find #"\.ba[mi]$" (:object props))]
+             bam? (re-find #"\.ba[mi]$" (:object props))
+             img? (re-find #"\.(?:(jpe?g|png|gif|bmp))$" (:object props))
+             hide-preview? (or bam? img?)]
          [:div {:style {:width 700 :overflow "auto"}}
           (labeled "Google Bucket" (:bucket-name props))
           (labeled "Object" (:object props))
           [:div {:style {:marginTop "1em"}}
-           [:div {} (if bam?
+           [:div {} (if hide-preview?
                       "Preview is not supported for this filetype."
                       "Previews may not be supported for some filetypes.")]
-           (when (and (not bam?) (> data-size preview-byte-count))
+           (when (and (not hide-preview?) (> data-size preview-byte-count))
              (str "Last " (:preview-line-count @state) " lines are shown. Use link below to view entire file." data-size))
            ;; The max-height of 206 looks random, but it's so that the top line of the log preview is half cut-off
            ;; to hint to the user that they should scroll up.
-           (when-not (or data-empty bam?)
+           (when-not (or data-empty hide-preview?)
              (react/create-element
               [:div {:ref "preview" :style {:marginTop "1em" :whiteSpace "pre-wrap" :fontFamily "monospace"
                                             :fontSize "90%" :overflowY "auto" :maxHeight 206


print all types at depth

print all types at depth

--- src/atom_finder/core.clj
+++ src/atom_finder/core.clj
@@ -53,17 +53,19 @@
         p (.getParameterTypes m)]
         (alength p)))

+(defn children [node] (.getChildren node))
+
 (defn pre-tree
   ([f node] (pre-tree f node 1))
   ([f node index]

-   (let [children (.getChildren node)
+   (let [children (children node)
          ret (case (arg-count f)
                    1 (f node)
                    2 (f node index))]

      (conj
-           (for [iast-node (.getChildren node)]
+           (for [iast-node (children node)]
              (pre-tree f iast-node (inc index)))
            ret))))

@@ -90,33 +92,17 @@
   (inc
    (apply max 0
           (map depth
-               (.getChildren node)))))
+               (children node)))))

-(defn leaf? [node] (empty? (.getChildren node)))
+(defn leaf? [node] (empty? (children node)))

 (defn leaves [node]
   (if (leaf? node)
     node
-    (flatten (map leaves (.getChildren node)))))
+    (flatten (map leaves (children node)))))

-(defn node-str
-  "Convert single node to string"
-  [node]
-  (if (nil? node)
-    "nil1"
-    (let [stx (.getSyntax node)]
-      (if (nil? stx)
-        "nil2"
-        (.getImage stx)))))
-
-(map node-str (leaves root))
-
-(defn write [node]
-  (let [writer (ASTWriter.)]
-    (.write writer node)))
-
-(print (write (ancestor 2 (nth (leaves root) 11))))
-(println "\n\n")
+(def writer (ASTWriter.))
+(defn write [node] (.write writer node))

 (defn stringify
   "Convert multiple tree to string"
@@ -130,28 +116,28 @@
 (defn ancestor
   "Get the nth grandparent of the node"
   [n node]
-  (fn-pow #(.getParent %) node n))
+  (fn-pow #(.getParent %) node (dec n)))

-(defn filter-size
+(defn filter-depth
   "Return every sub-tree of size n"
   [n node]
-  (distinct (map #(ancestor n %) (leaves node))))
+  ;; start from the leaves of the tree and walk upwards n generations
+  (let [candidates (distinct (map #(ancestor n %) (leaves node)))]
+    ;; candidates may still have deeper branches than the one we came up from
+    (filter #(= n (depth %)) candidates)))

-(node-str (nth (filter-size 2 root) 3))
-(map node-str (.getChildren (nth (filter-size 2 root) 3)))
+(defn type [node]
+  (let [name (-> node .getClass .getSimpleName)]
+    (nth (re-find #"CPPAST(.*)" name) 1)))

-

 (def filename "/Users/dgopstein/nyu/confusion/atoms/simplifications/2000-natori/nonconfusing.c")
 (def root (translation-unit filename))

 (defn -main
   [& args]
-  (prn (file-content filename))
-  (for [incld (file-includes filename)] (printf "include - %s\n" (.getName incld)))

-  (visit-ast filename)
-  (ast-visitor-proxy)
-  (print-tree root)
-  (pre-tree #(-> % .getClass .getSimpleName) root)
+  (doseq [ancestor (filter-depth 1 root)]
+    (println (type ancestor) (write ancestor) "\n-----------------\n\n"))
+
   )