add PersistentHashMap.fromArray

add PersistentHashMap.fromArray

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -6274,6 +6274,16 @@
     (TransientHashMap. (js-obj) root cnt has-nil? nil-val)))

 (set! (.-EMPTY PersistentHashMap) (PersistentHashMap. nil 0 nil false nil empty-unordered-hash))
+
+(set! (.-fromArray PersistentHashMap)
+  (fn [arr ^boolean no-clone]
+    (let [arr (if no-clone arr (aclone arr))
+          len (alength arr)]
+      (loop [i 0 ret (transient (.-EMPTY PersistentHashMap))]
+        (if (< i len)
+          (recur (+ i 2)
+            (-assoc! ret (aget arr i) (aget arr (inc i))))
+          (-persistent! ret))))))

 (set! (.-fromArrays PersistentHashMap)
   (fn [ks vs]


CLJS-757: Remove redundant bounds checking in PersistentVector and TransientVector.

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -3261,16 +3261,28 @@
 (defn- vector-index-out-of-bounds [i cnt]
   (throw (js/Error. (str "No item " i " in vector of length " cnt))))

-(defn- array-for [pv i]
-  (if (and (<= 0 i) (< i (.-cnt pv)))
-    (if (>= i (tail-off pv))
+(defn- first-array-for-longvec [pv]
+  ;; invariants: (count pv) > 32.
+  (loop [node (.-root pv)
+         level (.-shift pv)]
+    (if (pos? level)
+      (recur (pv-aget node 0) (- level 5))
+      (.-arr node))))
+
+(defn- unchecked-array-for [pv i]
+  ;; invariant: i is a valid index of pv (use array-for if unknown).
+  (if (>= i (tail-off pv))
       (.-tail pv)
       (loop [node (.-root pv)
              level (.-shift pv)]
         (if (pos? level)
           (recur (pv-aget node (bit-and (bit-shift-right-zero-fill i level) 0x01f))
                  (- level 5))
-          (.-arr node))))
+          (.-arr node)))))
+
+(defn- array-for [pv i]
+  (if (and (<= 0 i) (< i (.-cnt pv)))
+    (unchecked-array-for pv i)
     (vector-index-out-of-bounds i (.-cnt pv))))

 (defn- do-assoc [pv level node i val]
@@ -3324,7 +3336,7 @@
      (== 1 cnt) (-with-meta cljs.core.PersistentVector.EMPTY meta)
      (< 1 (- cnt (tail-off coll)))
       (PersistentVector. meta (dec cnt) shift root (.slice tail 0 -1) nil)
-      :else (let [new-tail (array-for coll (- cnt 2))
+      :else (let [new-tail (unchecked-array-for coll (- cnt 2))
                   nr (pop-tail coll shift root)
                   new-root (if (nil? nr) cljs.core.PersistentVector.EMPTY_NODE nr)
                   cnt-1 (dec cnt)]
@@ -3365,8 +3377,8 @@
   (-seq [coll]
     (cond
       (zero? cnt) nil
-      (< cnt 32) (array-seq tail)
-      :else (chunked-seq coll 0 0)))
+      (<= cnt 32) (IndexedSeq. tail 0)
+      :else (chunked-seq coll (first-array-for-longvec coll) 0 0)))

   ICounted
   (-count [coll] cnt)
@@ -3376,7 +3388,7 @@
     (aget (array-for coll n) (bit-and n 0x01f)))
   (-nth [coll n not-found]
     (if (and (<= 0 n) (< n cnt))
-      (-nth coll n)
+      (aget (unchecked-array-for coll n) (bit-and n 0x01f))
       not-found))

   ILookup
@@ -3418,7 +3430,7 @@
     (let [step-init (array 0 init)] ; [step 0 init init]
       (loop [i 0]
         (if (< i cnt)
-          (let [arr (array-for v i)
+          (let [arr (unchecked-array-for v i)
                 len (alength arr)]
             (let [init (loop [j 0 init (aget step-init 1)]
                          (if (< j len)
@@ -3530,21 +3542,17 @@
   (-chunked-first [coll]
     (array-chunk node off))
   (-chunked-rest [coll]
-    (let [l (alength node)
-          s (when (< (+ i l) (-count vec))
-              (chunked-seq vec (+ i l) 0))]
-      (if (nil? s)
-        ()
-        s)))
+    (let [end (+ i (alength node))]
+      (if (< end (-count vec))
+        (chunked-seq vec (unchecked-array-for vec end) end 0)
+        ())))

   IChunkedNext
   (-chunked-next [coll]
-    (let [l (alength node)
-          s (when (< (+ i l) (-count vec))
-              (chunked-seq vec (+ i l) 0))]
-      (if (nil? s)
-        nil
-        s)))
+    (let [end (+ i (alength node))]
+      (when (< end (-count vec))
+        (chunked-seq vec (unchecked-array-for vec end) end 0))))
+
   IHash
   (-hash [coll] (caching-hash coll hash-coll __hash))

@@ -3714,23 +3722,21 @@
       :else (do (pv-aset node subidx nil)
                 node))))

-(defn- editable-array-for [tv i]
-  (if (and (<= 0 i) (< i (.-cnt tv)))
-    (if (>= i (tail-off tv))
-      (.-tail tv)
-      (let [root (.-root tv)]
-        (loop [node  root
-               level (.-shift tv)]
-          (if (pos? level)
-            (recur (tv-ensure-editable
-                    (.-edit root)
-                    (pv-aget node
-                             (bit-and (bit-shift-right-zero-fill i level)
-                                      0x01f)))
-                   (- level 5))
-            (.-arr node)))))
-    (throw (js/Error.
-            (str "No item " i " in transient vector of length " (.-cnt tv))))))
+(defn- unchecked-editable-array-for [tv i]
+  ;; invariant: i is a valid index of tv.
+  (if (>= i (tail-off tv))
+    (.-tail tv)
+    (let [root (.-root tv)]
+      (loop [node  root
+             level (.-shift tv)]
+        (if (pos? level)
+          (recur (tv-ensure-editable
+                   (.-edit root)
+                   (pv-aget node
+                            (bit-and (bit-shift-right-zero-fill i level)
+                                     0x01f)))
+                 (- level 5))
+          (.-arr node))))))

 (deftype TransientVector [^:mutable cnt
                           ^:mutable shift
@@ -3814,7 +3820,7 @@
         (== 1 cnt)                       (do (set! cnt 0) tcoll)
         (pos? (bit-and (dec cnt) 0x01f)) (do (set! cnt (dec cnt)) tcoll)
         :else
-        (let [new-tail (editable-array-for tcoll (- cnt 2))
+        (let [new-tail (unchecked-editable-array-for tcoll (- cnt 2))
               new-root (let [nr (tv-pop-tail tcoll shift root)]
                          (if-not (nil? nr)
                            nr


add new interop helper for invoking methods like "@@iterator" which are not valid unquoted JS object properties

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -202,6 +202,12 @@
      (into-array nil aseq))
   ([type aseq]
      (reduce (fn [a x] (.push a x) a) (array) aseq)))
+
+(defn js-invoke
+  "Invoke JavaScript object method via string. Needed when the
+  string is not a valid unquoted property name."
+  [obj s & args]
+  (.apply (aget obj s) obj (into-array args)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;; core protocols ;;;;;;;;;;;;;


Don't flip promoted bit when AWS creds aren't available.

--- src/clojars/promote.clj
+++ src/clojars/promote.clj
@@ -95,18 +95,17 @@
 (defn- deploy-to-s3 [info]
   (let [files (reduce (partial add-coords info) {}
                       ["jar" "jar.asc" "pom" "pom.asc"])]
-    (when (config :releases-secret-key)
-      (aether/deploy-artifacts :artifacts (keys files)
-                               :files files
-                               :transfer-listener :stdout
-                               :repository {"releases" releases}))))
+    (aether/deploy-artifacts :artifacts (keys files)
+                             :files files
+                             :transfer-listener :stdout
+                             :repository {"releases" releases})))

 (defn promote [{:keys [group name version] :as info}]
   (korma/transaction
    (println "checking" group "/" name "for promotion...")
    (let [blockers (blockers info)]
      (if (empty? blockers)
-       (do
+       (when (config :releases-secret-key)
          (println "Promoting" info)
          (deploy-to-s3 info)
          ;; TODO: this doesn't seem to be happening. db locked?


Add :gtm to push-types

Add :gtm to push-types

--- src/clojush/globals.clj
+++ src/clojush/globals.clj
@@ -10,8 +10,9 @@

 (def push-types '(:exec :code :integer :float :boolean :char :string :zip
                   :vector_integer :vector_float :vector_boolean :vector_string
-                  :input :output :auxiliary :tag :return :environment :genome))
-;; The list of stacks used by the Push interpreter
+                  :input :output :auxiliary :tag :return :environment :genome
+                  :gtm))
+;; The list of stacks and non-stack storage types used by the Push interpreter

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -146,3 +147,4 @@
 ;; will require quil.core, which will launch the quil sketch.

 (def viz-data-atom (atom {}))
+


Reformat and tweak docs.

Reformat and tweak docs.

--- src/clojush/globals.clj
+++ src/clojush/globals.clj
@@ -11,56 +11,136 @@
 ;; instructions; all others, with few exceptions, should be defined in push-argmap
 ;; in args.clj and should be passed to whatever functions use them as arguments.

-;; push-types is the list of stacks used by the Push interpreter
 (def push-types '(:exec :code :integer :float :boolean :char :string :zip
                         :vector_integer :vector_float :vector_boolean :vector_string
-                        :input :output :auxiliary
-                        :tag :return :environment :genome)) ;; Stack types
+                        :input :output :auxiliary :tag :return :environment :genome))
+;; The list of stacks used by the Push interpreter

-;; These definitions are used by instructions to keep computed values within limits
-;; or when using random instructions.
-(def max-number-magnitude 1000000000000) ;; Used by keep-number-reasonable as the maximum size of any integer or float
-(def min-number-magnitude 1.0E-10) ;; Used by keep-number-reasonable as the minimum magnitude of any float
-(def max-string-length 5000) ;; Used by string instructions to ensure that strings don't get too large
-(def max-vector-length 5000) ;; Used by vector instructions to ensure that vectors don't get too large
-(def min-random-integer -10) ;; The minumum value created by the integer_rand instruction
-(def max-random-integer 10) ;; The maximum value created by the integer_rand instruction
-(def min-random-float -1.0) ;; The minumum value created by the float_rand instruction
-(def max-random-float 1.0) ;; The maximum value created by the float_rand instruction
-(def min-random-string-length 1) ;; The minimum length of string created by the string_rand instruction
-(def max-random-string-length 10) ;; The maximum length of string created by the string_rand instruction
-(def max-points-in-random-expressions 50) ;; The maximum length of code created by the code_rand instruction
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Used by instructions to keep computed values within limits or when using random
+;; instructions.

-;; These atoms are used in different places and are therefore difficult to make fully functional
-(def evaluations-count (atom 0)) ;; Used to count the number of times GP evaluates an individual
-(def point-evaluations-count (atom 0)) ;; Used to count the number of instructions that have been executed
-(def timer-atom (atom 0)) ;; Used for timing of different parts of PushGP
-(def timing-map (atom {:initialization 0 :reproduction 0 :report 0 :fitness 0 :other 0}))  ;; Used for timing of different parts of pushgp
-(def solution-rates (atom (repeat 0))) ;; Used in historically-assessed hardness
-(def elitegroups (atom ())) ;; Used for elitegroup lexicase selection (will only work if lexicase-selection is off)
-(def epsilons-for-epsilon-lexicase (atom ())) ;; Used in epsilon lexicase. Only calculated once per population
-(def population-behaviors (atom ())) ;; Used to store the behaviors of the population for use in tracking behavioral diversity
-(def selection-counts (atom {})) ;; Used to store the number of selections for each individual, indexed by UUIDs
+(def max-number-magnitude 1000000000000)
+;; Used by keep-number-reasonable as the maximum size of any integer or float
+
+(def min-number-magnitude 1.0E-10)
+;; Used by keep-number-reasonable as the minimum magnitude of any float
+
+(def max-string-length 5000)
+;; Used by string instructions to ensure that strings don't get too large
+
+(def max-vector-length 5000)
+;; Used by vector instructions to ensure that vectors don't get too large
+
+(def min-random-integer -10)
+;; The minumum value created by the integer_rand instruction
+
+(def max-random-integer 10)
+;; The maximum value created by the integer_rand instruction
+
+(def min-random-float -1.0)
+;; The minumum value created by the float_rand instruction
+
+(def max-random-float 1.0)
+;; The maximum value created by the float_rand instruction
+
+(def min-random-string-length 1)
+;; The minimum length of string created by the string_rand instruction
+
+(def max-random-string-length 10)
+;; The maximum length of string created by the string_rand instruction
+
+(def max-points-in-random-expressions 50)
+;; The maximum length of code created by the code_rand instruction
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Used in many places and difficult to make fully functional
+
+(def evaluations-count (atom 0))
+;; Used to count the number of times GP evaluates an individual
+
+(def point-evaluations-count (atom 0))
+;; Used to count the number of instructions that have been executed
+
+(def timer-atom (atom 0))
+;; Used for timing of different parts of PushGP
+
+(def timing-map (atom {:initialization 0 :reproduction 0 :report 0 :fitness 0 :other 0}))
+;; Used for timing of different parts of pushgp
+
+(def solution-rates (atom (repeat 0)))
+;; Used in historically-assessed hardness
+
+(def elitegroups (atom ()))
+;; Used for elitegroup lexicase selection (will only work if lexicase-selection is off)
+
+(def epsilons-for-epsilon-lexicase (atom ()))
+;; Used in epsilon lexicase. Only calculated once per population
+
+(def population-behaviors (atom ()))
+;; Used to store the behaviors of the population for use in tracking behavioral diversity
+
+(def selection-counts (atom {}))
+;; Used to store the number of selections for each individual, indexed by UUIDs
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; The globals below may be reset by arguments to pushgp
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; These definitions are used by Push instructions and therefore must be global
-(def global-atom-generators (atom ())) ;; The instructions and literals that may be used in Push programs.
-(def global-max-points (atom 100)) ;; The maximum size of a Push program. Also, the maximum size of code that can appear on the exec or code stacks.
-(def global-tag-limit (atom 10000)) ;; The size of the tag space
-(def global-epigenetic-markers (atom [:close])) ;; A vector of the epigenetic markers that should be used in the individuals. Implemented options include: :close, :silent
-(def global-close-parens-probabilities (atom [0.772 0.206 0.021 0.001])) ;; A vector of the probabilities for the number of parens ending at that position. See random-closes in clojush.random
-(def global-silent-instruction-probability (atom 0.2)) ;; If :silent is used as an epigenetic-marker, this is the probability of random instructions having :silent be true

-;; These definitions are used by run-push (and functions it calls), and must be global since run-push is called by the problem-specifc error functions
-(def global-top-level-push-code (atom false)) ;; When true, run-push will push the program's code onto the code stack prior to running
-(def global-top-level-pop-code (atom false)) ;; When true, run-push will pop the code stack after running the program
-(def global-evalpush-limit (atom 150)) ;; The number of Push instructions that can be evaluated before stopping evaluation
-(def global-evalpush-time-limit (atom 0)) ;; The time in nanoseconds that a program can evaluate before stopping, 0 means no time limit
-(def global-pop-when-tagging (atom true)) ;; When true, tagging instructions will pop the exec stack when tagging; otherwise, the exec stack is not popped
+(def global-atom-generators (atom ()))
+;; The instructions and literals that may be used in Push programs.

-;; These definitions are used by some problem-specific error functions, and must therefore be global
-(def global-parent-selection (atom :lexicase)) ;; The type of parent selection used
-(def global-print-behavioral-diversity (atom false)) ;; When true, reports will print the behavioral diversity of the population
+(def global-max-points (atom 100))
+;; The maximum size of a Push program. Also, the maximum size of code that can appear on
+;; the exec or code stacks.
+
+(def global-tag-limit (atom 10000))
+;; The size of the tag space
+
+(def global-epigenetic-markers (atom [:close]))
+;; A vector of the epigenetic markers that should be used in the individuals. Implemented
+;; options include: :close, :silent
+
+(def global-close-parens-probabilities (atom [0.772 0.206 0.021 0.001]))
+;; A vector of the probabilities for the number of parens ending at that position. See
+;; random-closes in clojush.random
+
+(def global-silent-instruction-probability (atom 0.2))
+;; If :silent is used as an epigenetic-marker, this is the probability of random
+;; instructions having :silent be true
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; These definitions are used by run-push (and functions it calls), and must be global
+;; since run-push is called by the problem-specifc error functions
+
+(def global-top-level-push-code (atom false))
+;; When true, run-push will push the program's code onto the code stack prior to running
+
+(def global-top-level-pop-code (atom false))
+;; When true, run-push will pop the code stack after running the program
+
+(def global-evalpush-limit (atom 150))
+;; The number of Push instructions that can be evaluated before stopping evaluation
+
+(def global-evalpush-time-limit (atom 0))
+;; The time in nanoseconds that a program can evaluate before stopping, 0 means no time limit
+
+(def global-pop-when-tagging (atom true))
+;; When true, tagging instructions will pop the exec stack when tagging; otherwise, the exec
+;; stack is not popped
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; These definitions are used by some problem-specific error functions, and must therefore
+;; be global
+
+(def global-parent-selection (atom :lexicase))
+;; The type of parent selection used
+
+(def global-print-behavioral-diversity (atom false))
+;; When true, reports will print the behavioral diversity of the population
+


coordinator invariant should take into account jobs being deallocated.

--- src/onyx/log/replica_invariants.clj
+++ src/onyx/log/replica_invariants.clj
@@ -14,14 +14,6 @@
   (let [slot-id-peers (mapcat keys (vals (reduce merge (vals task-slot-ids))))]
     (and (= slot-id-peers (distinct slot-id-peers))
          (empty? (remove (set peers) slot-id-peers)))))
-
-(defn all-peers-have-sites-invariant
-  [{:keys [peers peer-sites]
-    :as replica}]
-  ;; FIXME
-  true
-  #_(let [all-peers (set (mapcat keys [peer-sites]))]
-    (or (= 1 (count peers)) (empty? (remove all-peers peers)))))

 (defn all-groups-invariant
   [{:keys [groups prepared accepted pairs]
@@ -45,8 +37,12 @@

 (defn all-jobs-have-coordinator
   [replica]
-  (every? (fn [[job _]]
-            (get-in replica [:coordinators job]))
+  (every? (fn [[job job-allocations]]
+            ;; if no peers allocated, no coordinator should be allocated
+            (or (and (empty? (apply concat (vals job-allocations)))
+                     (nil? (get-in replica [:coordinators job])))
+                ;; if peers are allocated, a coordinator should be allocated
+                (get-in replica [:coordinators job])))
           (:allocations replica)))

 (defn no-extra-coordinators
@@ -57,7 +53,8 @@
 (defn all-coordinators-exist
   [replica]
   (every? (fn [coord]
-            (some #{coord} (:peers replica)))
+            (or (nil? coord)
+                (some #{coord} (:peers replica))))
           (vals (:coordinators replica))))

 (defn active-job-invariant


CMR-3387: Fixing searching with CMR providers when using with the memory database.

--- metadata-db-app/src/cmr/metadata_db/services/search_service.clj
+++ metadata-db-app/src/cmr/metadata_db/services/search_service.clj
@@ -80,13 +80,15 @@
 (defn- find-cmr-concepts
   "Find tags or tag associations with specific parameters"
   [context params]
-  (let [db (db-util/context->db context)
-        latest-only? (or (true? (:latest params))
-                         (= "true" (:latest params)))
-        params (dissoc params :latest)]
-    (if latest-only?
-      (c/find-latest-concepts db {:provider-id "CMR"} params)
-      (c/find-concepts db [{:provider-id "CMR"}] params))))
+  (when (or (nil? (:provider-id params))
+            (= "CMR" (:provider-id params)))
+    (let [db (db-util/context->db context)
+          latest-only? (or (true? (:latest params))
+                           (= "true" (:latest params)))
+          params (dissoc params :latest)]
+      (if latest-only?
+        (c/find-latest-concepts db {:provider-id "CMR"} params)
+        (c/find-concepts db [{:provider-id "CMR"}] params)))))

 (defn- find-provider-concepts
   "Find concepts with specific parameters"


Add missing test case

Add missing test case

--- test/cljc/specium/core_test.cljc
+++ test/cljc/specium/core_test.cljc
@@ -36,6 +36,8 @@
       (s/keys :req [(or (and ::int ::even) ::str)])
       (s/keys :req-un [(or (and ::int ::even) ::str)])
       (s/keys :opt [::int] :opt-un [::str])
+
+      (s/merge (s/keys :req [::int]) (s/keys :req [::str]))

       (s/every ::int :kind vector? :count 3 :distinct true)
       (s/every integer? :into #{} :min-count 3 :max-count 5 :gen-max 3)


Fixed bug in runSimulation

Fixed bug in runSimulation

--- src/research_clojure/eChild/processingSentences.clj
+++ src/research_clojure/eChild/processingSentences.clj
@@ -370,7 +370,7 @@
 (defn runSimulation
   [sentences max_eChildren max_sentences]
   (def count (atom 0))
-  (while (< count max_eChildren)
+  (while (< @count max_eChildren)
     (println count)
     (doesChildLearnGrammar? sentences max_sentences)
     (swap! count inc)))


tree-query/ query and pred-query seem to work

--- src/com/billpiel/mem_tracer/util/tree_query.clj
+++ src/com/billpiel/mem_tracer/util/tree_query.clj
@@ -16,8 +16,6 @@
               (right-sib-zips d))
     []))

-
-
 (defn set-zip-children
   [z c]
   (z/edit z #(z/make-node z
@@ -35,8 +33,6 @@
   ((or *get-tags-mz* get-tags)
    node
    pred-map))
-
-#_ (get-tags' {:id 1} {:a #(-> % :id #{1}) :b #(-> % :id #{1})})

 (defn insert-tags-into-parent-tag-summary
   [& [tags summary]]
@@ -48,10 +44,10 @@
                       <>))
            [])
    :set (if tags
-          (-> summary
-              :set
-              (or #{})
-              (conj tags))
+          (-<> summary
+               :set
+               (or #{})
+               (apply conj <> tags))
           #{})})

 (defn merge-children-tag-summary
@@ -71,10 +67,10 @@
                (or [[]])
                (mapv #(into [tag] %)
                      <>))
-   :set (-> ch-tags
-            :set
-            (or #{})
-            (conj tag))})
+   :set (-<> ch-tags
+             :set
+             (or #{})
+             (apply conj <> tag))})

 (defn get-children-tag-summary*
   [zipr pred-map]
@@ -129,13 +125,37 @@
       (let [zn (z/next z)]
         (if-not (z/end? zn)
           (recur (tag* zn pred-map))
-          (z/root z))))))
+          ;; reset zipper
+          (z/edit zipr (-> z z/root constantly)))))))
+
+(defn pred-query
+  [zipr pred]
+  (let [z' (set-zip-children zipr
+                             (->> zipr
+                                  children-zips
+                                  (mapcat #(pred-query %
+                                                       pred))
+                                  vec))
+        n (z/node z')]
+    (if (-> n
+            meta
+            ::?
+            pred)
+      [n] ;; clear meta ::?
+      (z/children z'))))
+
+(defn query
+  [zipr pred-map pred-final]
+  (-> zipr
+      (tag pred-map)
+      (pred-query pred-final)))

 #_ (do
-     (def tree2 (tag z1
-                     {:a #(-> % :id #{1 2 3 4}) :even #(-<> (do %)
-                                                            :id
-                                                            even?)}))
+     (def z2 (tag z1
+                  {:a #(-> % :id #{1 2 3 4}) :even #(-<> (do %)
+                                                         :id
+                                                         even?)}))
+
      (ppcp tree2)
      (println)
      (-> tree2
@@ -172,6 +192,10 @@
                        #(assoc % :children %2)
                        tree))

+     (def qr1 (query z1 {:a #(-> % :id #{6})}
+                     #(->> % :children :set (some #{:a}))
+                     ))
+
      (ppcp (z/root z1))


Add toggle for generative tests

Add toggle for generative tests

--- src/discuss/config.cljs
+++ src/discuss/config.cljs
@@ -5,6 +5,7 @@
 (goog-define version "x.y.z")
 (goog-define build-commit "dev")
 (goog-define experimental-features? true)
+(goog-define generative-tests? false)

 #_(goog-define remote-host "http://discuss.cn.uni-duesseldorf.de:4284/api")
 (def remote-host


Issue 9729: Added compojure (clojure web framework) scaffolding - which will be used for new admin interface implementation.

git-svn-id: b7e9aa1d6cd963481915708f70423d437278b157@17496 bd66a97b-2aff-0310-9095-89ca5cabf5a6

--- src/test/clojure/com/imcode/imcms/compojure.clj
+++ src/test/clojure/com/imcode/imcms/compojure.clj
@@ -1,6 +1,9 @@
-(ns com.imcode.imcms.compojure)
+(ns com.imcode.imcms.compojure

-(use 'compojure)
+  (:gen-class :extends javax.servlet.http.HttpServlet))
+
+
+(use 'compojure 'clojure.contrib.def)

 (defn html-doc
   [title & body]
@@ -10,56 +13,63 @@
       [:head
         [:title title]]
       [:body
-       [:div
-        [:h2
-         ;; Pass a map as the first argument to be set as attributes of the element
-         [:a {:href "/"} "Home"]]]
-              body]]))
+        [:div
+          [:h2
+            [:a {:href "/"} "Main (welcome page)"]
+          [:h2
+            [:a {:href "/doc"} "Document"]]
+          [:h2
+            [:a {:href "/user"} "Users"]]
+          [:h2
+            [:a {:href "/role"} "Roles"]]]]
+        body]]))

+(defn handle-doc
+  [action]
+  (let []
+    (html-doc "Result"
+      "Processing: " action)))

-(def sum-form
-  (html-doc "Sum"
-    (form-to [:post "/"]
-      (text-field {:size 3} :x)
-      "+"
-      (text-field {:size 3} :y)
-      "+"
-      (text-field {:size 3} :z)
-      (submit-button "="))))
+(defn undefined [request]
+  (html-doc "Undefined"
+    request))

-(defn result
-  [x y z]
-  (let [x (Integer/parseInt x)
-        y (Integer/parseInt y)
-        z (Integer/parseInt z)]
-    (html-doc "Result"
-      x " + " y " + " z " == " (+ x y z))))
+(defn welcome-page
+  []
+  (html-doc "imCMS admin" ">> Please pick a task <<"))

-(defroutes webservice
+(defroutes admin-services
   (GET "/"
-    sum-form)
+    (welcome-page))

-  (GET "/test"
-    (html-doc "Tst" (html (drop-down "species" [:cat :dog :buffalo :bunny :lion]))))
+  (GET "/doc"
+    (html-doc "Document"
+      (form-to [:post "/doc"]
+        (drop-down "action" [:new :delete :search])
+        (submit-button "Go"))))

-  (GET "/public/:ax/:bx/:cx"
-    (str "Loading file: "
-         request))
+  (POST "/doc"
+    (handle-doc (params :action)))
+
+  (GET "/user"
+    (undefined request))
+
+  (GET "/role"
+     (undefined request))

   (GET "/image"
     (java.io.File. "/Users/ajosua/Pictures/ant.jpg"))

   (ANY "*"
-    [404 "Page Not Found"])
-
-  (POST "/"
-    (result (params :x) (params :y) (params :z))))
+    [404 "Page Not Found"]))

-(def srv (atom nil))
+
+
+(defvar srv (atom nil))

 (defn srv-start
   ([]
@@ -70,7 +80,7 @@
       (run-server
         {:port port}
         "/*"
-        (servlet webservice)))))
+        (servlet admin-services)))))

 (defn srv-stop []
   (stop @srv))


Add real ->Example and ->Note impls

Add real ->Example and ->Note impls

--- src/grimoire/things.clj
+++ src/grimoire/things.clj
@@ -226,6 +226,16 @@
   [namespace name]
   (let [v (->def namespace name)]
     (assoc v ::url (thing->path v))))
+
+(defn ->Example
+  [thing name handle]
+  (let [v (->example thing name handle)]
+    (assoc v ::url handle)))
+
+(defn ->Note
+  [thing name handle]
+  (let [v (->note thing name handle)]
+    (assoc v ::url handle)))

 ;; Manipulating things and strings


OO: Return nil instead of invalid dates

OO: Return nil instead of invalid dates

--- src/hatti/charting.cljc
+++ src/hatti/charting.cljc
@@ -43,8 +43,12 @@
   "Converts string to integer, for typ (int|date)."
   (case typ
     "int" parse-int
-    "date" #(let [l (tc/to-long (new js/Date %))]
-              (when l (safe-floor (/ l millis-in-day))))))
+    "date" (fn [date-string]
+             (when date-string
+               (-> (new js/Date date-string)
+                   tc/to-long
+                   (/ millis-in-day)
+                   safe-floor)))))

 (defn int->str [typ &{:keys [digits]
                       :or   {digits 1}}]
@@ -54,7 +58,9 @@
         d->millis #(* millis-in-day %)
         date->str #? (:clj  #(tf/unparse (tf/formatters :year-month-day)
                                          (tc/from-long  %))
-                      :cljs #(.format (js/moment %) "ll"))]
+                      :cljs (fn [date]
+                              (when date
+                                (.format (js/moment date) "ll"))))]
     (case typ
       "int"  #(format int-fmt-s (float %))
       "date" #(date->str (d->millis %)))))
@@ -74,7 +80,8 @@
    metadata of this above value would be:
    {:bins ['1 to 2', '3 to 4', '5 to 6', '7 to 8', '9 to 10']}"
      [answers bins typ]
-     (let [numbers (map (str->int typ) answers)
+     (let [numbers (->> answers
+                        (map (str->int typ)))
            mx (reduce max (remove nil? numbers))
            mn (reduce min (remove nil? numbers))
            s (scale/linear :domain [mn mx] :range [0 (- bins (/ 1 10000))])
@@ -89,7 +96,8 @@
            strings (-> strings distinct vec)] ; remove repeats before output
        (with-meta results
          {:bins (if (contains? (set answers) nil)
-                  (conj strings nil) strings)}))))
+                  (conj strings nil)
+                  strings)}))))

 (defn label-count-pairs
   "Take chart-data from the ona API, returns label->count map.


Provide an empty configuration

Provide an empty configuration

--- sample.clj
+++ sample.clj
@@ -1,7 +1,7 @@
 (ns sample
   (:require [http.async.client :as c]))

-(with-client
+(with-client {}
   (let [r (c/GET "http://example.com/")]
    (println "done?" (c/done? r))
    (c/await r)


Make web logging messages more useful.

Make web logging messages more useful.

--- modules/web/src/main/clojure/immutant/web.clj
+++ modules/web/src/main/clojure/immutant/web.clj
@@ -30,7 +30,8 @@
 (defn start-servlet
   "Can be used to mount a servlet in lieu of a typical Ring handler"
   [sub-context-path servlet]
-  (log/info (str "Starting servlet at URL: " (util/app-uri) sub-context-path))
+  (log/info (format "Starting servlet for %s at: %s%s" (util/app-name)
+              (util/app-uri) sub-context-path))
   (start* sub-context-path
           (servlet/proxy-servlet servlet)
           {}))
@@ -38,7 +39,8 @@
 (defn start-handler
   "Typically not called directly; use start instead"
   [sub-context-path handler & {:keys [init destroy] :as opts}]
-  (log/info (str "Starting handler at URL: " (util/app-uri) sub-context-path))
+  (log/info (format "Starting handler for %s at: %s%s" (util/app-name)
+              (util/app-uri) sub-context-path))
   (start* sub-context-path
           (servlet/create-servlet (add-middleware handler opts))
           opts))


Default the language to "de"

Default the language to "de"

--- src/mdr2/production.clj
+++ src/mdr2/production.clj
@@ -57,6 +57,7 @@
   "Return default meta data"
   []
   {:date (to-date (t/now))
+   :language "de"
    :identifier (uuid)
    :volumes 1
    :type "Text"


small fixes

small fixes

--- src/me/panzoo/story.clj
+++ src/me/panzoo/story.clj
@@ -21,6 +21,7 @@
 ; method. When run from the REPL or from Leiningen `gen-class` does nothing.
   (:gen-class))

+(declare encode-anchor)

 ;@top-level-vars
 ; ## Top level variables
@@ -457,7 +458,7 @@
 ; `*brushes*` is rebound on every invocation of `render-files`, because if it
 ; was not, unneeded brushes could accumulate and be included on subsequent
 ; calls to `render-files`.
-  (binding [*brushes* (atom (or (set *static-brushes*) #{})
+  (binding [*brushes* (atom (or (set (:static-brushes *settings*)) #{})
                             :validator #(not (some (comp not string?) %)))]
     (render-files- paths)))

@@ -486,7 +487,7 @@

 ; Here is a list of the options this program can take when run from the
 ; commandline.
-                 ["-c" "--comment" "Comment syntax" :default ";"]
+                 ["-c" "--comment" "Comment syntax"]
                  ["-b" "--brush" "SyntaxHighlighter brush file" :multi true]
                  ["-t" "--theme" "SyntaxHighlighter theme file"]
                  ["-l" "--language" "SyntaxHighlighter language"]
@@ -508,7 +509,7 @@
     (if (or (not (seq tail)) (:help amap))
       (do (println (str usage "\n" banner))
         (System/exit 1))
-      (binding [*settings* {:theme (:theme amap)
+      (binding [*settings* {:theme (or (:theme amap) (:theme *settings*))
                             :stylesheet (:stylesheet amap)
                             :static-brushes (:brush amap)
                             :verbose? (:verbose amap)}


Don't document the max-header-length.

Don't document the max-header-length.

--- src/multicodec/core.clj
+++ src/multicodec/core.clj
@@ -15,7 +15,7 @@
   (Charset/forName "UTF-8"))

-(def max-header-length
+(def ^:no-doc max-header-length
   "The maximum length (in bytes) a header path can be."
   127)


clj learning

clj learning

--- server/project.clj
+++ server/project.clj
@@ -9,4 +9,4 @@
                  [compojure "1.1.6"]
                  [de.ubercode.clostache/clostache "1.3.1"]
                  [com.datomic/datomic-free "0.8.4218"]]
-  :main poetroid.core)
+  :main poetroid.data)


desactivate corp cards only when rezzed

desactivate corp cards only when rezzed

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -83,7 +83,8 @@
     (let [dest (if (sequential? to) (vec to) [to])
           c (if (and (= side :corp) (= (first dest) :discard) (:rezzed card))
               (assoc card :seen true) card)
-          c (if (and (#{:servers :rig :scored} (first zone)) (#{:hand :deck :discard} (first dest)))
+          c (if (and (#{:servers :rig :scored} (first zone)) (#{:hand :deck :discard} (first dest))
+                     (or (= (:side card) "Runner") (:rezzed card)))
               (desactivate state side c) c)
           moved-card (assoc c :zone dest)]
       (if front


Fix typo.

Fix typo.

--- src/oc/email/mailer.clj
+++ src/oc/email/mailer.clj
@@ -64,7 +64,7 @@
         msg (keywordize-keys message)
         company-name (:company-name msg)
         from (:from msg)
-        prefix (if (s/blank? from) ("You've been invited") (str from " invites you"))
+        prefix (if (s/blank? from) "You've been invited" (str from " invites you"))
         company (if (s/blank? company-name) "" (str company-name " on "))
         subject (str prefix " to join " company "OpenCompany")
         invitation (assoc msg :subject subject)]


Collect problems with the same :in and :val

--- src/pinpointer/core.clj
+++ src/pinpointer/core.clj
@@ -21,8 +21,10 @@

 (defn pinpoint-out [ed & {:keys [root]}]
   (when-let [problems (::s/problems ed)]
-    (doseq [[i problem] (map-indexed vector problems)
-            :let [{:keys [val in pred reason]} problem
+    (doseq [[i probs] (->> problems
+                           (group-by #(select-keys % [:val :in]))
+                           (map-indexed vector))
+            :let [[{:keys [val in]} probs] probs
                   val (or root val)
                   [start end] (extract val in)]]
       (when (not= i 0)
@@ -32,9 +34,12 @@
       (println "   Input:" (pr-str val))
       (printf  "        :%s\n" (wavy-line start end))
       (print "Expected: ")
-      (prn pred)
-      (when reason
-        (printf "(%s)\n" reason)))))
+      (doseq [[j {:keys [pred reason]}] (map-indexed vector probs)]
+        (when (not= j 0)
+          (print "          "))
+        (prn pred)
+        (when reason
+          (printf "(%s)\n" reason))))))

 (defn pinpoint [spec x]
   (pinpoint-out (s/explain-data spec x) :root x))


fix color order

fix color order

--- src/set_solver/util.clj
+++ src/set_solver/util.clj
@@ -67,7 +67,7 @@
 (defn scalar-to-hsl
   "Convert a scalar RGB color to HSL"
   [color]
-  (apply colors/rgb-to-hsl (take 3 (.val color))))
+  (apply colors/rgb-to-hsl (reverse (take 3 (.val color)))))

 (defn hu-invariants
   "Calculate Hu invariants from moments"


wrong method name

wrong method name

--- src/syncserver/core.clj
+++ src/syncserver/core.clj
@@ -19,7 +19,7 @@
   `(when @debug-mode (println ~@text)))

-(def cache! (.. (CacheBuilder/newBuilder) (expireAfterRead 5 TimeUnit/SECONDS) (build)))
+(def cache! (.. (CacheBuilder/newBuilder) (expireAfterAccess 5 TimeUnit/SECONDS) (build)))

 (def current-state
   (atom {:state nil


Updated out of date test.

Updated out of date test.

--- test/cmr/authz/tests/unit/token.clj
+++ test/cmr/authz/tests/unit/token.clj
@@ -20,5 +20,5 @@
          (token/parse-token xml-test-body))))

 (deftest parse-username
-  (is (= ["4l1c3"]
+  (is (= "4l1c3"
          (token/parse-username xml-test-body))))


move browser_connected_repl_url to renderContext

--- frontend/core.cljs
+++ frontend/core.cljs
@@ -97,7 +97,7 @@
    (let [previous-state @state]
      (swap! state (partial nav-con/navigated-to history (first value) (second value)))
      (nav-pcon/post-navigated-to! history (first value) (second value) previous-state @state))))
-
+
 (defn api-handler
   [value state container]
   (when true (:log-channels? utils/initial-query-map)
@@ -145,15 +145,11 @@
   (put! ws-ch [:subscribe {:channel-name (pusher/user-channel user)
                            :messages [:refresh]}]))

-(defn setup-browser-repl []
-  (when-let [repl-url (aget js/window "browser_connected_repl_url")]
-    (try
-      (repl/connect repl-url)
-      ;; the repl tries to take over *out*, workaround for
-      ;; https://github.com/cemerick/austin/issues/49
-      (js/setInterval #(enable-console-print!) 1000)
-      (catch js/Error e
-        (merror e)))))
+(defn setup-browser-repl [repl-url]
+  (repl/connect repl-url)
+  ;; the repl tries to take over *out*, workaround for
+  ;; https://github.com/cemerick/austin/issues/49
+  (js/setInterval #(enable-console-print!) 1000))

 (defn dispatch-to-current-location! []
   (let [uri (goog.Uri. js/document.location.href)]
@@ -178,4 +174,8 @@
     (when-let [user (:current-user @state)]
       (subscribe-to-user-channel user (get-in @state [:comms :ws])))
     (when (env/development?)
-      (setup-browser-repl))))
+      (when-let [repl-url (get-in @state [:render-context :browser_connected_repl_url])]
+        (try
+          (setup-browser-repl repl-url)
+          (catch js/error e
+            (merror e)))))))


Fix issue with run-dmc not respecting options

browse-url within run-dmc* was not properly handling the options passed
to it resulting in the browser always being launched and pointed at
http://localhost:8080.

--- web/src/immutant/web/internal.clj
+++ web/src/immutant/web/internal.clj
@@ -45,7 +45,8 @@
         opts))))

 (defn ^:internal run-dmc* [run handler & options]
-  (let [result (apply run (wrap-dev-middleware handler) options)]
+  (let [result (apply run (wrap-dev-middleware handler) options)
+        options (u/kwargs-or-map->map options)]
     (browse-url (format "http://%s:%s%s"
                   (:host options (:host create-defaults))
                   (:port options (:port create-defaults))


Update compilation_test.clj

Update compilation_test.clj

--- modules/less/test/modular/less/compilation_test.clj
+++ modules/less/test/modular/less/compilation_test.clj
@@ -9,5 +9,5 @@
   (testing " start compilation"
     (start (new-less-compilation :engine :javascript
                   :less-config {:project-root "resources"
-                                :source-paths ["less"]
-                                :target-path "css"}))))
+                                :source-path "your-less-file.less"
+                                :target-path "your-css-file.css"}))))


Simplify get-owner function.

Simplify get-owner function.

--- src/vault/entity/tx.clj
+++ src/vault/entity/tx.clj
@@ -141,14 +141,14 @@
   "Looks up the owner for the given entity root id. Throws an exception if any
   of the ids is not an entity root."
   [store root-id]
-  (let [blob (edn/parse-data (store/get store root-id))]
-    (when-not blob
-      (throw (IllegalArgumentException.
+  (let [data (->> root-id (store/get store) edn/parse-data struct/data-value)]
+    (when-not data
+      (throw (IllegalStateException.
                (str "Cannot get owner for nonexistent entity " root-id))))
-    (when-not (root? (struct/data-value blob))
-      (throw (IllegalArgumentException.
+    (when-not (root? data)
+      (throw (IllegalStateException.
                (str "Cannot get owner for non-root blob " root-id))))
-    (:owner (struct/data-value blob))))
+    (:owner data)))

 (defn- get-update-owners


Fix email on copyright notice on token ns.

--- src/buddy/auth/backends/token.clj
+++ src/buddy/auth/backends/token.clj
@@ -1,4 +1,4 @@
-;; Copyright 2013-2015 Andrey Antukh <niwi@niwi.be>
+;; Copyright 2013-2015 Andrey Antukh <niwi@niwi.nz>
 ;;
 ;; Licensed under the Apache License, Version 2.0 (the "License")
 ;; you may not use this file except in compliance with the License.


Fix error handling for non-Exception Throwables.

This will resolve #7.

--- src/clj/com/climate/claypoole.clj
+++ src/clj/com/climate/claypoole.clj
@@ -308,10 +308,10 @@
                                            (let [result (apply f a)]
                                              (send-result @p)
                                              result)
-                                           ;; Even if we had an exception
+                                           ;; Even if we had an error
                                            ;; running the task, make sure the
                                            ;; future shows up in the queue.
-                                           (catch Exception e
+                                           (catch Throwable t
                                              ;; We've still got to send that
                                              ;; result, even if it was an
                                              ;; exception, and we have to do it
@@ -320,7 +320,8 @@
                                              ;; If we've had an exception, kill
                                              ;; future and ongoing processes.
                                              (@canceller i)
-                                             (throw e)))
+                                             ;; Re-throw that throwable!
+                                             (throw t)))
                                         ;; Add the args to the function's
                                         ;; metadata for prioritization.
                                         {:args a})))


Improve the database component

Improve the database component

Add a database protocol with the get-conn method on it.

--- src/clj/comic_reader/database.clj
+++ src/clj/comic_reader/database.clj
@@ -26,7 +26,11 @@
       ;;   @(d/transact conn (seed/data)))
       conn)))

-(defrecord Database [config conn]
+(defprotocol Database
+  (get-conn [database] "Return the connection to the database."))
+
+(defrecord DatomicDatabase [config conn]
+
   component/Lifecycle

   (start [component]
@@ -37,15 +41,13 @@

   (stop [component]
     (println "Comic-Reader: Disconnecting from database...")
-    (dissoc component :conn)))
+    (dissoc component :conn))
+
+  Database
+  (get-conn [database] (:conn database)))

 (defn database? [e]
   (instance? Database e))

 (defn new-database []
-  (map->Database {}))
-
-(defn get-conn [database]
-  (or (:conn database)
-      (when-let [config (:config database)]
-        (setup-and-connect-to-database config))))
+  (map->DatomicDatabase {}))


commented top level function call

commented top level function call

--- src/clj/xl/max_points_on_line.clj
+++ src/clj/xl/max_points_on_line.clj
@@ -88,4 +88,4 @@
     )
   )

-(samples)+;(samples)


docstring for `load` REPL special, delete docstrings for `require` et al., which are not REPL specials anymore

--- src/cljs/lumo/repl_resources.cljs
+++ src/cljs/lumo/repl_resources.cljs
@@ -116,89 +116,12 @@
 (def repl-special-doc-map
   '{in-ns {:arglists ([name])
            :doc "Sets *cljs-ns* to the namespace named by the symbol, creating it if needed."}
-    require {:arglists ([& args])
-             :doc "  Loads libs, skipping any that are already loaded. Each argument is
-  either a libspec that identifies a lib or a flag that modifies how all the identified
-  libs are loaded. Use :require in the ns macro in preference to calling this
-  directly.
-
-  Libs
-
-  A 'lib' is a named set of resources in classpath whose contents define a
-  library of ClojureScript code. Lib names are symbols and each lib is associated
-  with a ClojureScript namespace. A lib's name also locates its root directory
-  within classpath using Java's package name to classpath-relative path mapping.
-  All resources in a lib should be contained in the directory structure under its
-  root directory. All definitions a lib makes should be in its associated namespace.
-
-  'require loads a lib by loading its root resource. The root resource path
-  is derived from the lib name in the following manner:
-  Consider a lib named by the symbol 'x.y.z; it has the root directory
-  <classpath>/x/y/, and its root resource is <classpath>/x/y/z.clj. The root
-  resource should contain code to create the lib's namespace (usually by using
-  the ns macro) and load any additional lib resources.
-
-  Libspecs
-
-  A libspec is a lib name or a vector containing a lib name followed by
-  options expressed as sequential keywords and arguments.
-
-  Recognized options:
-  :as takes a symbol as its argument and makes that symbol an alias to the
-    lib's namespace in the current namespace.
-  :refer takes a list of symbols to refer from the namespace..
-  :refer-macros takes a list of macro symbols to refer from the namespace.
-  :include-macros true causes macros from the namespace to be required.
-
-  Flags
-
-  A flag is a keyword.
-  Recognized flags: :reload, :reload-all, :verbose
-  :reload forces loading of all the identified libs even if they are
-    already loaded
-  :reload-all implies :reload and also forces loading of all libs that the
-    identified libs directly or indirectly load via require or use
-  :verbose triggers printing information about each load, alias, and refer
-
-  Example:
-
-  The following would load the library clojure.string :as string.
-
-  (require '[clojure/string :as string])"}
-    require-macros {:arglists ([& args])
-                    :doc "Similar to the require REPL special function but
-    only for macros."}
-    use {:arglists ([& args])
-         :doc "Like require, but referring vars specified by the mandatory
-  :only option.
-
-  Example:
-
-  The following would load the library clojure.set while referring
-  the intersection var.
-
-  (use '[clojure.set :only [intersection]])"}
-    use-macros {:arglists ([& args])
-                :doc "Similar to the use REPL special function but
-    only for macros."}
-    refer-clojure {:arglists ([& args])
-                   :doc "Refers to all the public vars of `cljs.core`, subject to
-  filters.
-  Filters can include at most one each of:
-
-  :exclude list-of-symbols
-  :rename map-of-fromsymbol-tosymbol
-
-  Filters can be used to select a subset, via exclusion, or to provide a mapping
-  to a symbol different from the var's name, in order to prevent clashes."}
-    import {:arglists ([& import-symbols-or-lists])
-            :doc "import-list => (closure-namespace constructor-name-symbols*)
-
-  For each name in constructor-name-symbols, adds a mapping from name to the
-  constructor named by closure-namespace to the current namespace. Use :import in the ns
-  macro in preference to calling this directly."}
     load-file {:arglists ([name])
-               :doc "Sequentially read and evaluate the set of forms contained in the file."}})
+               :doc "Sequentially read and evaluate the set of forms contained in the file."}
+    load {:arglists ([& paths])
+          :doc "Loads Clojure code from resources in classpath. A path is interpreted as
+  classpath-relative if it begins with a slash or relative to the root
+  directory for the current namespace otherwise."}})

 #_(defn- repl-special-doc [name-symbol]
   (assoc (repl-special-doc-map name-symbol)


Typo fix: "Succesful" -> "Successful"

Typo fix: "Succesful" -> "Successful"

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -702,7 +702,7 @@
                             [:div.panel.blue-shade
                              (when-not (:no-action run) [:h4 "Waiting for Corp's actions" ])
                              (if (zero? (:position run))
-                               (cond-button "Succesful Run" (:no-action run) #(send-command "access"))
+                               (cond-button "Successful Run" (:no-action run) #(send-command "access"))
                                (cond-button "Continue" (:no-action run) #(send-command "continue")))
                              (cond-button "Jack Out" (not (get-in cursor [:run :cannot-jack-out]))
                                           #(send-command "jack-out"))]


Show tag icon when tagged with `:tagged` (Paparazzi)

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -485,7 +485,7 @@
 (defmulti stats-view #(get-in % [:identity :side]))

 (defmethod stats-view "Runner" [{:keys [user click credit run-credit memory link tag brain-damage agenda-point
-                                        max-hand-size]} owner]
+                                        tagged max-hand-size]} owner]
   (om/component
    (sab/html
     (let [me? (= (:side @game-state) :runner)]
@@ -500,7 +500,7 @@
        [:div (str link " Link" (if (> link 1) "s" "")) (when me? (controls :link))]
        [:div (str agenda-point " Agenda Point" (when (> agenda-point 1) "s"))
         (when me? (controls :agenda-point))]
-       [:div (str tag " Tag" (if (> tag 1) "s" "")) (when (> tag 0) [:div.warning "!"]) (when me? (controls :tag))]
+       [:div (str tag " Tag" (if (> tag 1) "s" "")) (when (or (> tag 0) (> tagged 0)) [:div.warning "!"]) (when me? (controls :tag))]
        [:div (str brain-damage " Brain Damage" (if (> brain-damage 1) "s" ""))
         (when me? (controls :brain-damage))]
        [:div (str max-hand-size " Max hand size") (when me? (controls :max-hand-size))]]))))


Remove paredit pref for now

Remove paredit pref for now

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -16,7 +16,6 @@

 (def editors (atom {}))
 (def font-size (atom (utils/read-pref :font-size)))
-(def disable-paredit? (utils/read-pref :disable-paredit))

 (defn get-editor
   [path]
@@ -162,8 +161,7 @@
   [path]
   (when (and (.isFile (java.io/file path))
              (contains? styles (get-extension path)))
-    (let [text-area (if (and (not disable-paredit?)
-                             (contains? paredit-exts (get-extension path)))
+    (let [text-area (if (contains? paredit-exts (get-extension path))
                       (paredit/paredit-widget (TextEditorPane.))
                       (TextEditorPane.))
           text-area-scroll (RTextScrollPane. text-area)


Improve how selection is preserved when tab is pressed

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -320,6 +320,26 @@
         text (.getText text-area)]
     (assoc (mwm/get-state text position) :should-indent? true)))

+(defn get-indent-state
+  [^TextEditorPane text-area reverse?]
+  (let [[start-pos end-pos] (get-cursor-position text-area)]
+    (if (not= start-pos end-pos)
+      (let [; find the selected lines
+            text (.getText text-area)
+            [start-line start-x] (mwm/position->row-col text start-pos)
+            [end-line end-x] (mwm/position->row-col text end-pos)
+            ; run parinfer on the text
+            state (get-parinfer-state text-area false)
+            ; adjust the selection
+            lines (:lines state)
+            new-text (str/join \newline lines)
+            start-x 0
+            end-x (count (get lines end-line))
+            new-start-pos (mwm/row-col->position new-text start-line start-x)
+            new-end-pos (mwm/row-col->position new-text end-line end-x)]
+        (assoc state :cursor-position [new-start-pos new-end-pos]))
+      (get-parinfer-state text-area false))))
+
 (defn add-indent!
   [^TextEditorPane text-area lines text tags state]
   (let [start-pos (first (:cursor-position state))
@@ -373,8 +393,12 @@
                                   (.getKeyCode e))
                        (.isControlDown e)
                        (.isMetaDown e)))
-              (->> (if (= (.getKeyCode e) KeyEvent/VK_ENTER)
+              (->> (cond
+                     (= (.getKeyCode e) KeyEvent/VK_ENTER)
                      (get-normal-state text-area)
+                     (= (.getKeyCode e) KeyEvent/VK_TAB)
+                     (get-indent-state text-area (.isShiftDown e))
+                     :else
                      (get-parinfer-state text-area false))
                    (refresh-content! text-area)
                    (mwm/update-edit-history! edit-history))))


updated goa rule to match fields generated by new file parser

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/temp/goa/goa.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/temp/goa/goa.clj
@@ -17,12 +17,12 @@
   :body ((?/go [rdfs/subClassOf *] obo/GO_0008150)
          (?/goid obo/IAO_0000219 ?/go) ; denotes
          (?/fv0 obo/IAO_0000219 ?/goid) ; denotes
-         (?/fv0 kiao/hasTemplate  iaogoa/GpAssociationGoaUniprotFileData_goIDDataField1)
+         (?/fv0 kiao/hasTemplate  iaogoa/GoaGaf2FileRecord_ontologyTermIdDataField1)

          (?/record obo/BFO_0000051 ?/fv0) ; has_part
          (?/record obo/BFO_0000051 ?/fv1) ; has_part

-         (?/fv1 kiao/hasTemplate iaogoa/GpAssociationGoaUniprotFileData_databaseObjectIDDataField1)
+         (?/fv1 kiao/hasTemplate iaogoa/GoaGaf2FileRecord_dbObjectIdDataField1)
          (?/fv1 obo/IAO_0000219 ?/gp) ; denotes
          (?/gp obo/IAO_0000219 ?/bioentity) ; denotes

@@ -30,7 +30,7 @@
          ;; ;;filter out the negations
           (:optional
            ((?/record obo/BFO_0000051 ?/qualfv) ; has_part
-            (?/qualfv kiao/hasTemplate iaogoa/GpAssociationGoaUniprotFileData_qualifierDataField1)
+            (?/qualfv kiao/hasTemplate iaogoa/GoaGaf2FileRecord_qualifierDataField)
             (?/qualfv obo/IAO_0000219 ?/qualifier))) ; denotes
           (:or (:not (:bound ?/qualifier))
                (:not (:regex ?/qualifier "^NOT" "i")))
@@ -77,12 +77,12 @@
   :body ((?/go [rdfs/subClassOf *] obo/GO_0005575) ;cellular_component
          (?/goid obo/IAO_0000219 ?/go) ; denotes
          (?/fv0 obo/IAO_0000219 ?/goid) ; denotes
-         (?/fv0 kiao/hasTemplate  iaogoa/GpAssociationGoaUniprotFileData_goIDDataField1)
+         (?/fv0 kiao/hasTemplate  iaogoa/GoaGaf2FileRecord_ontologyTermIdDataField1)

          (?/record obo/BFO_0000051 ?/fv0) ; has_part
          (?/record obo/BFO_0000051 ?/fv1) ; has_part

-         (?/fv1 kiao/hasTemplate iaogoa/GpAssociationGoaUniprotFileData_databaseObjectIDDataField1)
+         (?/fv1 kiao/hasTemplate iaogoa/GoaGaf2FileRecord_dbObjectIdDataField1)
          (?/fv1 obo/IAO_0000219 ?/gp) ; denotes
          (?/gp obo/IAO_0000219 ?/bioentity) ; denotes

@@ -90,7 +90,7 @@
          ;; ;;filter out the negations
           (:optional
            ((?/record obo/BFO_0000051 ?/qualfv) ; has_part
-            (?/qualfv kiao/hasTemplate iaogoa/GpAssociationGoaUniprotFileData_qualifierDataField1)
+            (?/qualfv kiao/hasTemplate iaogoa/GoaGaf2FileRecord_qualifierDataField1)
             (?/qualfv obo/IAO_0000219 ?/qualifier)))
           (:or (:not (:bound ?/qualifier))
                (:not (:regex ?/qualifier "^NOT" "i")))


Fix workflow map

Fix workflow map

I goozled myself.

--- src-cljs/frontend/components/pages/run.cljs
+++ src-cljs/frontend/components/pages/run.cljs
@@ -125,7 +125,7 @@
                          (if (feature/enabled? :workflow-map)
                            (let [jobs (-> this
                                           om-next/props
-                                          :routed-entity/run
+                                          :routed/run
                                           :run/jobs)
                                  nodes (map :job/name jobs)
                                  edges (for [job jobs


No /signup handler here

No /signup handler here

--- src/cylon/oauth/server/server.clj
+++ src/cylon/oauth/server/server.clj
@@ -265,7 +265,6 @@

   (routes [_]
     ["/" {"authorize" {:get ::authorization-endpoint}
-          "signup" {:get ::auth-signup-endpoint}
           "permit-client" {:post ::permit}
           ;; TODO: Can we use a hyphen instead here?
           "access_token" {:post ::token-endpoint}}])


Improve indentation.

Improve indentation.

--- src/dsbdp/data_processing_dsl.clj
+++ src/dsbdp/data_processing_dsl.clj
@@ -20,16 +20,18 @@
       (reduce
         (fn [v data-proc-def-element]
           (cond
-            (symbol? data-proc-def-element) (let [s data-proc-def-element]
-                                              (condp not= nil
-                                                (ns-resolve 'clojure.core s)
-                                                  (conj v (ns-resolve 'clojure.core s))
-                                                (ns-resolve 'dsbdp.byte-array-conversion s)
-                                                  (conj v (ns-resolve 'dsbdp.byte-array-conversion s) 'input)
-                                                (do
-                                                  (println "Could not resolve symbol:" s)
-                                                   v)))
-            (list? data-proc-def-element) (conj v (into '() (reverse (create-data-processing-sub-fn data-proc-def-element input offset))))
+            (symbol? data-proc-def-element)
+              (let [s data-proc-def-element]
+                (condp not= nil
+                  (ns-resolve 'clojure.core s)
+                    (conj v (ns-resolve 'clojure.core s))
+                  (ns-resolve 'dsbdp.byte-array-conversion s)
+                    (conj v (ns-resolve 'dsbdp.byte-array-conversion s) 'input)
+                  (do
+                    (println "Could not resolve symbol:" s)
+                    v)))
+            (list? data-proc-def-element)
+              (conj v (into '() (reverse (create-data-processing-sub-fn data-proc-def-element input offset))))
             :default (conj v data-proc-def-element)))
         [] data-processing-definition))))


cleanup login form

cleanup login form

--- src/cljs/swarmpit/component/page_login.cljs
+++ src/cljs/swarmpit/component/page_login.cljs
@@ -1,6 +1,6 @@
 (ns swarmpit.component.page-login
-  (:require [material.component :as comp]
-            [material.icon :as icon]
+  (:require [material.icon :as icon]
+            [material.component :as comp]
             [swarmpit.component.state :as state]
             [swarmpit.url :refer [dispatch!]]
             [swarmpit.storage :as storage]
@@ -39,22 +39,19 @@
     (login-handler local-state)))

 (defn- form-username [value local-state]
-  (comp/form-control
-    {:margin    "normal"
-     :required  true
-     :fullWidth true}
-    (comp/input-label
-      {:htmlFor "user"
-       :key     "Swarmpit-login-username-input-label"} "User")
-    (comp/input
-      {:id           "user"
-       :key          "Swarmpit-login-username-input"
-       :name         "user"
-       :autoComplete "user"
-       :autoFocus    true
-       :value        value
-       :onChange     (fn [event]
-                       (swap! local-state assoc :username (-> event .-target .-value)))})))
+  (comp/text-field
+    {:id              "user"
+     :key             "Swarmpit-login-username-input"
+     :label           "Username"
+     :variant         "outlined"
+     :fullWidth       true
+     :required        true
+     :autoComplete    "user"
+     :autoFocus       true
+     :value           value
+     :onChange        (fn [event]
+                        (swap! local-state assoc :username (-> event .-target .-value)))
+     :InputLabelProps {:shrink true}}))

 (defn- form-password-adornment [local-state]
   (let [show-password? (:showPassword @local-state)]
@@ -72,26 +69,23 @@

 (defn- form-password [value local-state]
   (let [show-password? (:showPassword @local-state)]
-    (comp/form-control
-      {:className "SwarmpitFormLogin"
-       :fullWidth true
-       :required  true}
-      (comp/input-label
-        {:htmlFor "adornment-password"
-         :key     "Swarmpit-login-password-input-label"} "Password")
-      (comp/input
-        {:id           "adornment-password"
-         :label        "Password"
-         :key          "Swarmpit-login-password-input"
-         :type         (if show-password?
-                         "text"
-                         "password")
-         :value        value
-         :onChange     (fn [event]
-                         (swap! local-state assoc :password (-> event .-target .-value)))
-         :onKeyPress   (fn [event]
-                         (on-enter event local-state))
-         :endAdornment (form-password-adornment local-state)}))))
+    (comp/text-field
+      {:id              "password"
+       :key             "Swarmpit-login-password-input"
+       :label           "Password"
+       :variant         "outlined"
+       :fullWidth       true
+       :required        true
+       :type            (if show-password?
+                          "text"
+                          "password")
+       :value           value
+       :onChange        (fn [event]
+                          (swap! local-state assoc :password (-> event .-target .-value)))
+       :onKeyPress      (fn [event]
+                          (on-enter event local-state))
+       :InputLabelProps {:shrink true}
+       :InputProps      {:endAdornment (form-password-adornment local-state)}})))

 (defn- form-button [local-state]
   (let [canSubmit? (:canSubmit @local-state)]
@@ -118,21 +112,10 @@
       (comp/mui
         (comp/paper
           {:className "Swarmpit-login-paper"}
-          (comp/avatar
-            {:className "Swarmpit-login-avatar"
-             :key       "Swarmpit-login-avatar"
-             :alt       "Swarmpit logo"
-             :src       "/img/swarmpit-transparent.png"})
-
-          ;(html
-          ;  [:img {:src    "img/swarmpit.png"
-          ;         :width  "80px"
-          ;         :height "80px"}])
-
-          (comp/typography
-            {:variant   "headline"
-             :key       "Swarmpit-login-text"
-             :className "Swarmpit-login-text"} "Welcome!")
+          (html
+            [:img {:src    "img/swarmpit.png"
+                   :width  "100%"
+                   :height "100%"}])
           (html
             [:form.Swarmpit-login-form {:key "Swarmpit-login-form"}
              (when (not-empty message)


Added support to retrieve iso formats by concept-id.

--- src/cmr/search/services/acls/acl_helper.clj
+++ src/cmr/search/services/acls/acl_helper.clj
@@ -38,6 +38,15 @@
         sids (context->sids context)]
     (filter (partial acl-matches-sids-and-permission? sids :read) acls)))

+(defn- get-iso-access-value
+  "Returns the iso-mends access value by parsing MENDS ISO xml"
+  [concept]
+  (when-let [[_ restriction-flag-str]
+             (re-matches #"(?s).*<gco:CharacterString>Restriction Flag:(.+?)</gco:CharacterString>.*"
+                         (:metadata concept))]
+    (when-not (re-find #".*<.*" restriction-flag-str)
+      (Double. ^String restriction-flag-str))))
+
 (defmulti extract-access-value
   "Extracts access value (aka. restriction flag) from the concept."
   (fn [concept]
@@ -52,4 +61,17 @@
 (defmethod extract-access-value "application/dif+xml"
   [concept]
   ;; DIF doesn't support restriction flag yet.
-  nil)+  nil)
+
+(defmethod extract-access-value "application/iso+xml"
+  [concept]
+  (get-iso-access-value concept))
+
+(defmethod extract-access-value "application/iso-mends+xml"
+  [concept]
+  (get-iso-access-value concept))
+
+(defmethod extract-access-value "application/iso-smap+xml"
+  [concept]
+  ;; SMAP ISO doesn't support restriction flag yet.
+  nil)


Lowercase word before looking it up

Lowercase word before looking it up

--- src/instantetymonline/client.cljs
+++ src/instantetymonline/client.cljs
@@ -16,7 +16,7 @@
             :value word
             :on-change (fn [e] (reset! local {:word (-> e .-target .-value)}))}]]
          [:br]
-         [:p {:style {"max-width" "35em"}} (get dict word)]]))))
+         [:p {:style {"max-width" "35em"}} (get dict (.toLowerCase word))]]))))

 (defn main-component []


consistency, spelling

consistency, spelling


Refactored render-ch and event-ch processsing into 2 goroutines.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -151,6 +151,7 @@
                         (if override override
                             (when (:closed actx-info)
                               (get-in @positions [actx-id])))))))
+
 ;; ------------------------------------------------

 (defn vis-html-ch [vis ch]
@@ -291,36 +292,42 @@
                    :chs {}   ; {ch -> {:id (gen-id),
                              ;         :msgs {msg -> true}
                              ;         :first-taker-actx actx-or-nil}}.
-                   :gen-id gen-id})]
-    (go-loop [num-events 0
-              vis-last nil
+                   :gen-id gen-id})
+        render-ch (chan)]
+    (go-loop [num-events 0]  ; Process events from world / simulation.
+      (let [[actx event] (<! event-ch)
+            [verb step & args] event
+            deltas ((get (get vis-event-handlers verb) step) vis actx args)]
+        (set-el-innerHTML (str el-prefix "-event")
+                          (str num-events ": " (last actx) " " verb " " step " " args))
+        (when (and (not (zero? @event-delay)) (not-empty deltas))
+          (>! render-ch [@vis deltas false])
+          (when (> @event-delay 0) (<! (timeout @event-delay)))
+          (when (< @event-delay 0) (<! step-ch)))
+        (>! render-ch [@vis deltas true])
+        (when (> @event-delay 0) (<! (timeout @event-delay)))
+        (when (< @event-delay 0) (<! step-ch)))
+        (recur (inc num-events)))
+    (go-loop [vis-last nil
               vis-last-positions nil
               vis-last-html nil
               vis-last-svg nil]
-      (let [[actx event] (<! event-ch)
-            [verb step & args] event
-            vis-positions (atom {})
-            vis-event-handler (get (get vis-event-handlers verb) step)
-            deltas (vis-event-handler vis actx args)
-            actx-ch-ch-infos (group-by #(:first-taker-actx (second %)) (:chs @vis))]
-        (set-el-innerHTML (str el-prefix "-event")
-                          (str num-events ": " (last actx) " " verb " " step " " args))
-        (when (and (not (zero? @event-delay)) (not-empty deltas) vis-last vis-last-positions)
-          (set-el-innerHTML (str el-prefix "-svg")
-                            (apply str (flatten (vis-svg-actxs vis-last vis-last-positions
-                                                               deltas false))))
-          (when (> @event-delay 0) (<! (timeout @event-delay)))
-          (when (< @event-delay 0) (<! step-ch)))
-        (assign-positions @vis @root-actx vis-positions actx-ch-ch-infos nil)
-        (let [vis-next-html (apply str (flatten (vis-html-actx @vis @root-actx actx-ch-ch-infos)))
-              vis-next-svg (apply str (flatten (vis-svg-actxs @vis @vis-positions deltas true)))]
-          (set-el-innerHTML (str el-prefix "-html") vis-next-html)
-          (set-el-innerHTML (str el-prefix "-svg") vis-next-svg)
-          (if (or (not= vis-next-html vis-last-html)
-                  (not= vis-next-svg vis-last-svg))
-            (when (> @event-delay 0) (<! (timeout @event-delay)))
-            (when (< @event-delay 0) (<! step-ch)))
-          (recur (inc num-events) @vis @vis-positions vis-next-html vis-next-svg))))
+      (let [[vis-next deltas after] (<! render-ch)] ; Process render-ch, updating U/I.
+        (if after
+          (let [vis-next-positions (atom {})
+                actx-ch-ch-infos (group-by #(:first-taker-actx (second %)) (:chs vis-next))]
+            (assign-positions vis-next @root-actx vis-next-positions actx-ch-ch-infos nil)
+            (let [vis-next-html (apply str (flatten (vis-html-actx vis-next @root-actx
+                                                                   actx-ch-ch-infos)))
+                  vis-next-svg (apply str (flatten (vis-svg-actxs vis-next @vis-next-positions
+                                                                  deltas true)))]
+              (set-el-innerHTML (str el-prefix "-html") vis-next-html)
+              (set-el-innerHTML (str el-prefix "-svg") vis-next-svg)
+              (recur vis-next @vis-next-positions vis-next-html vis-next-svg)))
+          (let [vis-next-svg (apply str (flatten (vis-svg-actxs vis-last vis-last-positions
+                                                                deltas false)))]
+            (set-el-innerHTML (str el-prefix "-svg") vis-next-svg)
+            (recur vis-last vis-last-positions vis-last-html vis-next-svg)))))
     (ago world w
          (reset! root-actx world)
          (let [in-ch (achan-buf world 100)
@@ -340,7 +347,8 @@
         (let [actx-id (no-prefix (.-id (.-target (<! toggle-ch))))]
           (doseq [[actx actx-info] (:actxs @vis)]
             (when (= actx-id (last actx))
-              (swap! vis #(assoc-in % [:actxs actx :closed] (not (:closed actx-info))))))
+              (swap! vis #(assoc-in % [:actxs actx :closed] (not (:closed actx-info))))
+              (>! render-ch [@vis nil])))
           (recur))))
     (vis-run-controls event-delay step-ch el-prefix)))


Renamed main to user.

Renamed main to user.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -293,13 +293,13 @@
          (reset! root-actx world)
          (let [in (achan-buf world 100)
                out (achan-buf world 0)]
-           (ago-loop main-in world [num-ins 0]
+           (ago-loop user-in world [num-ins 0]
                      (let [cmd (<! cmds)
                            cmd-handler ((get cmd-handlers (:op cmd)) cmd)]
-                       (aput main-in in cmd-handler)
+                       (aput user-in in cmd-handler)
                        (recur (inc num-ins))))
-           (ago-loop main-out world [num-outs 0]
-                     (let [result (atake main-out out)]
+           (ago-loop user-out world [num-outs 0]
+                     (let [result (atake user-out out)]
                        (set-el-innerHTML "output" result)
                        (recur (inc num-outs))))
            (make-fenced-pump world in out @max-inflight)))))


Check id in block-stats to catch nils from file->id.

--- src/blocks/store/file.clj
+++ src/blocks/store/file.clj
@@ -86,8 +86,9 @@
 (defn- block-stats
   "Calculates a merged stat map for a block."
   [id ^File file]
-  (merge (file-stats file)
-         {:id id, :size (.length file)}))
+  (when id
+    (merge (file-stats file)
+           {:id id, :size (.length file)})))

 (defn- id->file
@@ -159,7 +160,7 @@
   (-list
     [this opts]
     (->> (find-files root (:after opts))
-         (map #(block-stats (file->id root %) %))
+         (keep #(block-stats (file->id root %) %))
          (block/select-stats opts)))


reformat

reformat

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

--- src/lt/plugins/auto_complete.cljs
+++ src/lt/plugins/auto_complete.cljs
@@ -146,87 +146,87 @@
             hints)))

 (def hinter (-> (scmd/filter-list {:items (fn []
-                                        (when-let [cur (pool/last-active)]
-                                          (distinct-completions
-                                           (if (:starting-token @hinter)
-                                             (remove #(= (-> @hinter :starting-token :string) (.-completion %))
-                                                     (object/raise-reduce cur :hints+ []))
-                                             (object/raise-reduce cur :hints+ [])))))
-                               :key text|completion})
+                                            (when-let [cur (pool/last-active)]
+                                              (distinct-completions
+                                               (if (:starting-token @hinter)
+                                                 (remove #(= (-> @hinter :starting-token :string) (.-completion %))
+                                                         (object/raise-reduce cur :hints+ []))
+                                                 (object/raise-reduce cur :hints+ [])))))
+                                   :key text|completion})
                 (object/add-tags [:hinter])))

 (behavior ::textual-hints
-                  :triggers #{:hints+}
-                  :reaction (fn [this hints]
-                              (concat (::hints @this) hints)))
+          :triggers #{:hints+}
+          :reaction (fn [this hints]
+                      (concat (::hints @this) hints)))

 (behavior ::escape!
-                  :triggers #{:escape!}
-                  :reaction (fn [this force?]
-                              (let [elem (object/->content this)]
-                                (when (:line @this)
-                                  (js/CodeMirror.off (:line @this) "change" on-line-change))
-                                (ctx/out! [:editor.keys.hinting.active])
-                                (when (or force? (= 0 (count (:cur @this))))
-                                  (keyboard/passthrough))
-                                (object/merge! this {:active false
-                                                     :selected 0
-                                                     :ed nil
-                                                     :starting-token nil
-                                                     :token nil
-                                                     :search ""})
-                                (object/raise this :inactive)
-                                (when (dom/parent elem)
-                                  (dom/remove elem)))))
+          :triggers #{:escape!}
+          :reaction (fn [this force?]
+                      (let [elem (object/->content this)]
+                        (when (:line @this)
+                          (js/CodeMirror.off (:line @this) "change" on-line-change))
+                        (ctx/out! [:editor.keys.hinting.active])
+                        (when (or force? (= 0 (count (:cur @this))))
+                          (keyboard/passthrough))
+                        (object/merge! this {:active false
+                                             :selected 0
+                                             :ed nil
+                                             :starting-token nil
+                                             :token nil
+                                             :search ""})
+                        (object/raise this :inactive)
+                        (when (dom/parent elem)
+                          (dom/remove elem)))))

 (behavior ::select
-                  :triggers #{:select}
-                  :reaction (fn [this c]
-                              (let [token (:token @this)
-                                    start {:line (:line token)
-                                           :ch (:start token)}
-                                    end {:line (:line token)
-                                         :ch (:end token)}]
-                                (object/merge! this {:active false})
-                                (if (.-select c)
-                                  ((.-select c) (partial editor/replace (:ed @this) start end) c)
-                                  (editor/replace (:ed @this) start end (.-completion c)))
-                                (object/raise this :escape!))))
+          :triggers #{:select}
+          :reaction (fn [this c]
+                      (let [token (:token @this)
+                            start {:line (:line token)
+                                   :ch (:start token)}
+                            end {:line (:line token)
+                                 :ch (:end token)}]
+                        (object/merge! this {:active false})
+                        (if (.-select c)
+                          ((.-select c) (partial editor/replace (:ed @this) start end) c)
+                          (editor/replace (:ed @this) start end (.-completion c)))
+                        (object/raise this :escape!))))

 (behavior ::select-unknown
-                  :triggers #{:select-unknown}
-                  :reaction (fn [this v]
-                              (object/raise this :escape!)
-                              (keyboard/passthrough)))
+          :triggers #{:select-unknown}
+          :reaction (fn [this v]
+                      (object/raise this :escape!)
+                      (keyboard/passthrough)))

 (behavior ::line-change
-                  :triggers #{:line-change}
-                  :reaction (fn [this l c]
-                              (when (:active @hinter)
-                                (let [pos (editor/->cursor (:ed @this))
-                                      token (get-token (:ed @this) pos)]
-                                  (if (or (non-token-change? (:ed @this) c)
-                                          (< (:ch pos) (-> @hinter :starting-token :start)))
-                                    (object/raise hinter :escape!)
-                                    (do
-                                      (object/raise hinter :change! (:string token))
-                                      (object/merge! hinter {:token token})))))))
+          :triggers #{:line-change}
+          :reaction (fn [this l c]
+                      (when (:active @hinter)
+                        (let [pos (editor/->cursor (:ed @this))
+                              token (get-token (:ed @this) pos)]
+                          (if (or (non-token-change? (:ed @this) c)
+                                  (< (:ch pos) (-> @hinter :starting-token :start)))
+                            (object/raise hinter :escape!)
+                            (do
+                              (object/raise hinter :change! (:string token))
+                              (object/merge! hinter {:token token})))))))
 (defn on-line-change [line ch]
   (object/raise hinter :line-change line ch))

 (behavior ::async-hint-tokens
-                  :triggers #{:hint-tokens}
-                  :reaction (fn [this tokens]
-                              (object/merge! this {::hints tokens})))
+          :triggers #{:hint-tokens}
+          :reaction (fn [this tokens]
+                      (object/merge! this {::hints tokens})))

 (behavior ::intra-buffer-string-hints
-                  :triggers #{:change}
-                  :debounce 400
-                  :reaction (fn [this ch]
-                              (when (or (not= (:ed @hinter) this)
-                                        (not (:active @hinter)))
-                                (async-hints this))
-                              ))
+          :triggers #{:change}
+          :debounce 400
+          :reaction (fn [this ch]
+                      (when (or (not= (:ed @hinter) this)
+                                (not (:active @hinter)))
+                        (async-hints this))
+                      ))

 (defn start-hinting [this opts]
   (let [pos (editor/->cursor this)
@@ -251,50 +251,50 @@
                (js/CodeMirror.positionHint (editor/->cm-ed this) elem (:start token)))))))

 (behavior ::show-hint
-                  :triggers #{:hint}
-                  :reaction (fn [this opts]
-                              (let [cur (string/trim (editor/get-char this -1))
-                                    opts (merge {:select-single true} opts)]
-                                (cond
-                                 (and (:active @hinter)
-                                      (= (:ed @hinter) this)) (object/raise hinter :select!)
-                                 (and (empty? cur)
-                                      (not (:force? opts))) (keyboard/passthrough)
-                                 (:active @hinter) (do (object/raise hinter :escape!) (start-hinting this))
-                                 :else (start-hinting this opts)))))
+          :triggers #{:hint}
+          :reaction (fn [this opts]
+                      (let [cur (string/trim (editor/get-char this -1))
+                            opts (merge {:select-single true} opts)]
+                        (cond
+                         (and (:active @hinter)
+                              (= (:ed @hinter) this)) (object/raise hinter :select!)
+                         (and (empty? cur)
+                              (not (:force? opts))) (keyboard/passthrough)
+                         (:active @hinter) (do (object/raise hinter :escape!) (start-hinting this))
+                         :else (start-hinting this opts)))))

 (behavior ::remove-on-scroll-inactive
-                  :triggers #{:scroll :inactive}
-                  :reaction (fn [this]
-                              (when (:active @hinter)
-                                (object/raise hinter :escape!))))
+          :triggers #{:scroll :inactive}
+          :reaction (fn [this]
+                      (when (:active @hinter)
+                        (object/raise hinter :escape!))))

 (behavior ::remove-on-move-line
-                  :triggers #{:move}
-                  :reaction (fn [this c]
-                              (when (:active @hinter)
-                                ;;HACK: line change events are sent *after* cursor move
-                                ;;this means that we need to wait for those to fire and then
-                                ;;check if we're out of bounds.
-                                (wait 0 (fn []
-                                          (let [starting (:starting-token @hinter)
-                                                cur (:token @hinter)
-                                                cursor (editor/->cursor this)]
-                                            (when (and starting
-                                                       cur
-                                                       (or (not (<= (:start cur) (:ch cursor) (:end cur)))
-                                                           (not= (:line starting) (:line cursor))))
-                                              (object/raise hinter :escape!))))))))
+          :triggers #{:move}
+          :reaction (fn [this c]
+                      (when (:active @hinter)
+                        ;;HACK: line change events are sent *after* cursor move
+                        ;;this means that we need to wait for those to fire and then
+                        ;;check if we're out of bounds.
+                        (wait 0 (fn []
+                                  (let [starting (:starting-token @hinter)
+                                        cur (:token @hinter)
+                                        cursor (editor/->cursor this)]
+                                    (when (and starting
+                                               cur
+                                               (or (not (<= (:start cur) (:ch cursor) (:end cur)))
+                                                   (not= (:line starting) (:line cursor))))
+                                      (object/raise hinter :escape!))))))))

 (behavior ::auto-show-on-input
-                  :triggers #{:input}
-                  :type :user
-                  :desc "Auto-complete: Show on change"
-                  :reaction (fn [this _ ch]
-                              (when-not (non-token-change? this ch)
-                                (when-not (and (:active @hinter)
-                                               (= (:ed @hinter) this))
-                                  (object/raise this :hint {:select-single false})))))
+          :triggers #{:input}
+          :type :user
+          :desc "Auto-complete: Show on change"
+          :reaction (fn [this _ ch]
+                      (when-not (non-token-change? this ch)
+                        (when-not (and (:active @hinter)
+                                       (= (:ed @hinter) this))
+                          (object/raise this :hint {:select-single false})))))

 (cmd/command {:command :auto-complete.remove
               :hidden true
@@ -325,10 +325,10 @@
 ;;*********************************************************

 (behavior ::init
-                  :triggers #{:init}
-                  :reaction (fn [this]
-                              (load/js "core/node_modules/codemirror/show-hint.js" :sync)
-                              (js/CodeMirror.extendMode "clojure" (clj->js {:hint-pattern #"[\w\-\>\:\*\$\?\<\!\+\.\/foo]"}))
-                              (js/CodeMirror.extendMode "text/x-clojurescript" (clj->js {:hint-pattern #"[\w\-\>\:\*\$\?\<\!\+\.\/foo]"}))
-                              (js/CodeMirror.extendMode "css" (clj->js {:hint-pattern #"[\w\.\-\#]"}))
-                              ))
+          :triggers #{:init}
+          :reaction (fn [this]
+                      (load/js "core/node_modules/codemirror/show-hint.js" :sync)
+                      (js/CodeMirror.extendMode "clojure" (clj->js {:hint-pattern #"[\w\-\>\:\*\$\?\<\!\+\.\/foo]"}))
+                      (js/CodeMirror.extendMode "text/x-clojurescript" (clj->js {:hint-pattern #"[\w\-\>\:\*\$\?\<\!\+\.\/foo]"}))
+                      (js/CodeMirror.extendMode "css" (clj->js {:hint-pattern #"[\w\.\-\#]"}))
+                      ))


include move-numbers in notation for white moves

--- src/main/cljs/chessdojo/core.cljs
+++ src/main/cljs/chessdojo/core.cljs
@@ -60,30 +60,32 @@
     (let [new-fen (cf/position->fen (:position (node new-game)))]
       (reset! state new-game)
       (js/updateBoard new-fen)
-    )
-  ))
+      )
+    ))

 (defn ^:export insert-move [move]
   (let [move-info (js->clj move)
-        move-coords {:from (get move-info "from") :to (get move-info "to") :piece (get move-info "piece") }
+        move-coords {:from (get move-info "from") :to (get move-info "to") :piece (get move-info "piece")}
         new-game (cg/insert-move @state move-coords)
         new-fen (cf/position->fen (:position (node new-game)))
         ]
     (reset! state new-game)
-    (js/updateBoard new-fen)
-    )
-  )
+    (js/updateBoard new-fen)))

-(defn move-view [move position path]
-  [:span {:style {:margin-right "5px"} :on-click #(update-board path)} (cg/move->long-str move)])
+(defn move-no [ply]
+  (when (odd? ply) (str (inc (quot ply 2)) ".")))
+
+(defn move-view [move path]
+  [:span {:style {:margin-right "5px"} :on-click #(update-board path)}
+   (str (move-no (first path)) (cg/move->long-str move))])

 (defn variation-view [nodes depth]
   [:div
    (for [node nodes]
      (if (vector? node)
-       ^{:key (str depth)} [variation-view node (inc depth)]
-       (let [move (:move node) position (:position node) path (:path (meta node))]
-         ^{:key path} [move-view move position path]
+       ^{:key (rand-int 100000)} [variation-view node (inc depth)]
+       (let [move (:move node) path (:path (meta node))]
+         ^{:key path} [move-view move path]
          )
        )
      )


add env port

add env port

--- src/leiningen/new/clanhr_service/routes.clj
+++ src/leiningen/new/clanhr_service/routes.clj
@@ -52,6 +52,7 @@
   "Gets the port to run the service"
   []
   (or (get (System/getenv) "PORT")
+      (get (System/getenv) "CLANHR_{{upper-and-sanitized-name}}_PORT")
       "5000"))

 (defn -main [& args]


warning for ignored :source-paths/:dependencies

far too common issue people seem to run into trying to configure
these in shadow-cljs.edn when using either :deps or :lein


* src/clj/cljs/compiler.clj: all tests pass

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -682,22 +682,41 @@
                  (not (-> f :info :dynamic))
                  (-> f :info :fn-var))
         js? (= (-> f :info :ns) 'js)
-        [f direct-variadic?]
+        [f variadic-invoke]
         (if fn?
           (let [info (-> f :info)
                 arity (count args)
-                mps (:method-params info)]
-            (if (or (> arity (:max-fixed-arity info))
-                    (= (count mps) 1))
-              [f false]
-              (let [arities (map count mps)]
-                (if (some #{arity} arities)
-                  [(update-in f [:info :name]
-                     (fn [name] (symbol (str name ".cljs$lang$arity$" arity)))) false]
-                  [f false]))))
-          [f false])]
+                variadic? (:variadic info)
+                mps (:method-params info)
+                mfa (:max-fixed-arity info)]
+            (cond
+             ;; if only one method, no renaming needed
+             (and (not variadic?)
+                  (= (count mps) 1))
+             [f nil]
+
+             ;; direct dispatch to variadic case
+             (and variadic? (> arity mfa))
+             [(update-in f [:info :name]
+                             (fn [name] (symbol (str name ".cljs$lang$arity$variadic"))))
+              {:max-fixed-arity mfa}]
+
+             ;; direct dispatch to specific arity case
+             :else
+             (let [arities (map count mps)]
+               (if (some #{arity} arities)
+                 [(update-in f [:info :name]
+                             (fn [name] (symbol (str name ".cljs$lang$arity$" arity)))) nil]
+                 [f nil]))))
+          [f nil])]
     (emit-wrap env
       (cond
+       variadic-invoke
+       (let [mfa (:max-fixed-arity variadic-invoke)]
+        (emits f "(" (comma-sep (take mfa args))
+               (when-not (zero? mfa) ",")
+               "cljs.core.array_seq([" (comma-sep (drop mfa args)) "], 0))"))
+
        (or fn? js?)
        (emits f "(" (comma-sep args)  ")")


CLJS-645: parse-ns needs to include 'constants-table as a dep

Did not having the constants-table as an implicit dependency on all
namespaces if cljs.analyzer/*track-constants* true. Minor refactor of
the logic in both compile-file* and parse-ns

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -872,10 +872,8 @@
                               :provides [ns-name]
                               :requires (if (= ns-name 'cljs.core)
                                           (set (vals deps))
-                                          (set
-                                            (remove nil?
-                                              (conj (set (vals deps)) 'cljs.core
-                                                (when ana/*track-constants* 'constants-table)))))
+                                          (cond-> (conj (set (vals deps)) 'cljs.core)
+                                            ana/*track-constants* (conj 'constants-table)))
                               :file dest
                               :source-file src
                               :lines (+ @*cljs-gen-line*
@@ -918,7 +916,8 @@
                            :provides [ns-name]
                            :requires (if (= ns-name 'cljs.core)
                                        (set (vals deps))
-                                       (conj (set (vals deps)) 'cljs.core))
+                                       (cond-> (conj (set (vals deps)) 'cljs.core)
+                                         ana/*track-constants* (conj 'constants-table)))
                            :file dest
                            :source-file src}
                           (when (and dest (.exists ^File dest))


removing print statemetns

removing print statemetns

--- src/clj/greenhouse/fx.clj
+++ src/clj/greenhouse/fx.clj
@@ -9,7 +9,6 @@
 (defn rounded
   [& {:keys [radius top-left top-right bottom-right bottom-left]
       :or {top-left 0 top-right 0 bottom-right 0 bottom-left 0}}]
-  (println "rounded radius: " radius)
   (list
     (if (pos? radius)
       {:-webkit-border-radius (px radius)
@@ -32,7 +31,6 @@

 (defn border-side
   [side]
-  (println "SIDE: " side)
   (keyword (str "border-" (name side))))

 (def orthogonal


Experiment with auto-formatting docstrings

--- src/cljs/fatlip/core.cljs
+++ src/cljs/fatlip/core.cljs
@@ -368,12 +368,14 @@

 (defn- single-edge-crossings
   "Counts the number of crossings that result from adding an edge, in order,
-  to the accumulator tree. If the index is even, meaning it's a right child of its
-  parent, we increment its value. If the index is odd (left child), we add the
-  value of its right sibling times the current weight to the cross count, as the
-  right sibling represents weight of the edges that were added ahead of this one,
-  and therefore, crossings. Then we walk up the tree to the root, incrementing and
-  adding right siblings, for a total count of edges that cross this one"
+  to the accumulator tree. If the index is even, meaning it's a right
+  child of its parent, we increment its value. If the index is
+  odd (left child), we add the value of its right sibling times the
+  current weight to the cross count, as the right sibling represents
+  weight of the edges that were added ahead of this one, and
+  therefore, crossings. Then we walk up the tree to the root,
+  incrementing and adding right siblings, for a total count of edges
+  that cross this one"
   [graph tree orig-index edge]
   (let [weight (count (:characters edge))
         is-seg-c (instance? SegmentContainer (:dest edge))]


"Supports" are strictly additive for user updates

--- src/cljs/geoforms/db.cljs
+++ src/cljs/geoforms/db.cljs
@@ -217,11 +217,14 @@
   [{:keys [email] :as user}
    ideas]
   (let [path [:users (munge- email)]]
-    ;; upsert the user
-    (m/reset-in! ref path (assoc user :created-at m/SERVER_TIMESTAMP))
-    ;; upsert the supported ideas
-    (set-user-ideas email ideas)))
-
+    (m/deref-in
+     ref (conj path :supports)
+     (fn [existing-ideas]
+       (let [ideas (into ideas (keys existing-ideas))]
+         ;; upsert the user
+         (m/reset-in! ref path (assoc user :created-at m/SERVER_TIMESTAMP))
+         ;; upsert the supported ideas
+         (set-user-ideas email ideas))))))

 ;; translations


fixed indentation

fixed indentation

--- src/cljs/memoria/app.cljs
+++ src/cljs/memoria/app.cljs
@@ -49,7 +49,7 @@

 (defn index-page-component []
   [:div
-  [:div {:class "banner" :key "banner"}]
+   [:div {:class "banner" :key "banner"}]
    [:div {:class "ui container main-content" :key "index-page-component"}
     [search-box-component]
     [cards-list-component @cards]]])


strange bugs/fixes in world

strange bugs/fixes in world

--- src/clojure/yaw/world.clj
+++ src/clojure/yaw/world.clj
@@ -114,12 +114,12 @@
 (defn create-item!
   "Create an item in the `world` with the
   specified id, position, mesh"
-  [world id & {:keys [x y z scale mesh]}
-            :or   {x 0
-                   y 0
-                   z 2
-                   scale    1
-                   mesh     (create-mesh! world)}]         ;;error here
+  [world id & {:keys [x y z scale mesh]
+               :or   {x 0
+                      y 0
+                      z 2
+                      scale    1
+                      mesh     (create-mesh! world)}}]         ;;error here
   (.createItemObject world id x y z scale mesh))

 (defn remove-item!
@@ -242,23 +242,23 @@

 (defn set-ambient-light!
   "Set the ambient light of the world"
-  [world l
-    (.setAmbient (lights world) l)])
+  [world l]
+    (.setAmbient (lights world) l))

 (defn set-sun!
   "Set the sun of the world"
-  [world l
-    (.setSun (lights world) l)])
+  [world l]
+    (.setSun (lights world) l))

 (defn set-point-light!
   "Set the `n`th pointlight with the given `color`, `position`, `itensity`, and attenuation factors"
-  [world n l
-    (.setPointLight (lights world) l n)])
+  [world n l]
+    (.setPointLight (lights world) l n))

 (defn set-spot-light!
   "Set the `n`th spotlight with the given `color`, `intensity`, `position`, `direction` and attenuation factors"
-  [world n l
-    (.setSpotLight (lights world) l n)])
+  [world n l]
+    (.setSpotLight (lights world) l n))

 ;;COLLISIONS------------------------------------------------------