More improvements to todomvc

More improvements to todomvc

--- examples/todomvc/src/todomvc/events.cljs
+++ examples/todomvc/src/todomvc/events.cljs
@@ -89,7 +89,7 @@
 ;; Advanced topic:  we inject the todos currently stored in LocalStore
 ;; into the first, coeffect parameter via `(inject-cofx :local-store-todos)`
 ;; To fully understand how that works, you'll have to review the tutorials.
-;; But, if you are interested, look at the bottom of `db.cljs` to see how this is done.
+;; If you are interested, look at the bottom of `db.cljs` to see how this is done.
 ;;
 (reg-event-fx                     ;; part of the re-frame API
   :initialise-db                  ;; event id being handled
@@ -101,7 +101,7 @@

 ;; usage:  (dispatch [:set-showing  :active])
 ;; This event is dispatched when the user clicks on the various
-;; filter buttons at the bottom of the panel. All, showing, done.
+;; filter buttons at the bottom of the panel. All, active or done.
 (reg-event-db      ;; part of the re-frame API
   :set-showing     ;; event-id
   [check-spec-interceptor]
@@ -109,7 +109,8 @@
     (assoc db :showing new-filter-kw)))

 ;; NOTE: here is a rewrite of the event handler above using `path` or `trimv`
-;; These interceptors can be interesting and useful, but they are a little advanced
+;; These interceptors can be interesting and useful, but they are an advanced topic.
+;; It will be illuminating to compare the version below with the one above.
 #_(reg-event-db
   :set-showing                    ;; event-id

@@ -141,8 +142,8 @@
   ;; value at `:todos` within `db`, rather than the full `db`.
   ;; And, further, it means the event handler returns just the value to be
   ;; put into `:todos` and not the entire `db`.
-  ;; So, a path interceptor makea the event handler act more like clojure's `update-in`
-  (fn [todos [text]]
+  ;; So, a path interceptor makes the event handler act more like clojure's `update-in`
+  (fn [todos [text]]   ;; because of trimv,  the 2nd parameter is NOT [_ text]
     (let [id (allocate-next-id todos)]
       (assoc todos id {:id id :title text :done false}))))


Add slow tag to integration spec

Add slow tag to integration spec

--- spec/reply/integration_spec.clj
+++ spec/reply/integration_spec.clj
@@ -28,7 +28,7 @@
             in (io/input-stream remote-url)]
         (io/copy in out)))))

-(describe "nrepl integration"
+(describe "nrepl integration" (tags :slow)

   (around [f]
     (ensure-test-jar clojure-151)
@@ -48,7 +48,6 @@

     (it "prints help on startup and exits properly"
       (let [fake-out (java.io.ByteArrayOutputStream.)]
-        (.flush System/out)
         (binding [*out* (java.io.PrintWriter. fake-out)]
           (with-redefs [exit/exit #()]
             (main/launch-nrepl {:attach (str *server-port*)
@@ -61,7 +60,6 @@

     (it "allows using doc"
       (let [fake-out (java.io.ByteArrayOutputStream.)]
-        (.flush System/out)
         (binding [*out* (java.io.PrintWriter. fake-out)]
           (with-redefs [exit/exit #()]
             (main/launch-nrepl {:attach (str *server-port*)
@@ -71,13 +69,11 @@
                                 :output-stream fake-out}))
           (should-contain (with-out-str (clojure.repl/doc map))
                           (str fake-out)))))
-
     )

   (describe "completion"

     (it "tab-completes clojure.core fns"
-        (.flush System/out)
       (let [fake-out (java.io.ByteArrayOutputStream.)]
         (binding [*out* (java.io.PrintWriter. fake-out)]
           (with-redefs [exit/exit #()]


Don't include the UNCOMMITTED state when serving bare repos

--- src/custard/core.clj
+++ src/custard/core.clj
@@ -67,22 +67,27 @@
 (defrecord Custard [dir repo watcher refs uncommitted]
   ICustard
   (states [this]
-    (into [@uncommitted] @refs))
+    (if @uncommitted
+      (into [@uncommitted] @refs)
+      @refs))

   (state [this id]
     (first (filter #(= id (:id %)) (states this))))

   component/Lifecycle
   (start [this]
-    (let [repo (git-repo/load dir)]
-      (reset! uncommitted (uncommitted-state dir))
+    (let [repo (git-repo/load dir)
+          bare? (.isBare (.getRepository repo))]
+      (when-not bare?
+        (reset! uncommitted (uncommitted-state dir)))
       (reset! refs (ref-states repo))
       (-> this
           (assoc :repo repo)
           (assoc :watcher
                  (watch-dir (fn [_]
-                              (reset! uncommitted
-                                      (uncommitted-state dir))
+                              (when-not bare?
+                                (reset! uncommitted
+                                        (uncommitted-state dir)))
                               (reset! refs (ref-states repo)))
                             dir)))))

@@ -99,4 +104,4 @@
                  :repo nil
                  :watcher nil
                  :refs (atom [])
-                 :uncommitted (atom [])}))
+                 :uncommitted (atom nil)}))


Improve listing blocks

Improve listing blocks

--- doc/src/tick/docs/app.cljs
+++ doc/src/tick/docs/app.cljs
@@ -34,28 +34,26 @@

 (defn button [label cb]
   [:button
-   {:class "code-button"
-    :key label
+   {:key label
     :onClick cb}
    label])

 (defn code-component [code result label]
   [:div
-   [:div.listingblock
-    [:div.content
-     [:pre code (when-let [v @result] (str " => " v))]]
-    [:div {:style {:text-align "right"}}
-     (let [m {}]
-       (list
-         (button "Eval" (fn [ev]
-                      (eval-code code
-                                 (fn [x]
-                                   (println (pr-str x))
-                                   (reset! result (str (:value x))))
-                                 label)))
-         (button "Clr" (fn [ev]
-                           (reset! result nil)
-                         ))))]]])
+   [:div.content
+    [:pre.highlight
+     [:code.language-clojure {:data-lang "clojure"} code (when-let [v @result] (str " => " v))]
+     [:div.code-buttons
+      (list
+        (button "Eval" (fn [ev]
+                         (eval-code code
+                                    (fn [x]
+                                      (println (pr-str x))
+                                      (reset! result (str (:value x))))
+                                    label)))
+        (button "Clr" (fn [ev]
+                        (reset! result nil)
+                        )))]]]])

 (defn interval-relations [config *value]
   (let [value (js/parseInt @*value 10) ; sometimes we get passed strings!
@@ -80,7 +78,7 @@
                 (->time (- (/ x-cells 2) (/ fixed-block-width-in-cells 2)))
                 (->time (+ (/ x-cells 2) (/ fixed-block-width-in-cells 2))))]

-    [:div
+    [:div.diagram
      [:div
       [:p
        [:input {:style {:width "100%"}
@@ -90,15 +88,13 @@
                 :onChange (fn [ev]
                             (reset! *value (.-value (.-target ev))))}]]]

-     [:div {:style {:border "0px dotted grey"
-                    :margin-bottom "24pt"}}
-      [:svg {:viewBox [0 0 width 40]}
-       [:rect
-        {:x (* cell-width value) :y 10 :width block-width :height 8 :fill "orange"}]
+     [:svg {:viewBox [0 0 width 40]}
+      [:rect
+       {:x (* cell-width value) :y 10 :width block-width :height 8 :fill "orange"}]

-       ;; fixed
-       [:rect
-        {:x (- (/ width 2) (/ fixed-block-width 2)) :y 30 :width fixed-block-width :height 8 :fill "#444"}]]]
+      ;; fixed
+      [:rect
+       {:x (- (/ width 2) (/ fixed-block-width 2)) :y 30 :width fixed-block-width :height 8 :fill "#444"}]]

      (letfn [(f [rel] (case rel
                         :precedes "precedes"
@@ -143,7 +139,7 @@
      :value (r/atom 0)}))

 (defn init []
-  (.log js/console "Starting up2…")
+  (.log js/console "Starting up…")

   (r/render [two-days-from-today]
             (.getElementById js/document "eval-two-days-from-today"))


Added static file handler for default response

--- vendor/compojure.clj
+++ vendor/compojure.clj
@@ -4,7 +4,6 @@
 (import '(javax.servlet.http HttpServlet
                              HttpServletRequest
                              HttpServletResponse))
-
 (defn includes?
   "Returns true if x is contained in coll, else false."
   [x coll]
@@ -84,13 +83,13 @@
      * string or seq - updates body
   Additionally, multiple updates can be chained through a vector.

-  e.g (update-response response \"Foo\")       ; write 'Foo' to response body
-      (update-response response [200 \"Bar\"]) ; set status 200, write 'Bar'"
-  [context #^HttpServletResponse response update]
+  e.g (update-response resp ctx \"Foo\")       ; write 'Foo' to response body
+      (update-response resp ctx [200 \"Bar\"]) ; set status 200, write 'Bar'"
+  [#^HttpServletResponse response context update]
   (cond
     (vector? update)
       (doseq d update
-        (update-response response d))
+        (update-response response context d))
     (string? update)
       (.. response (getWriter) (print update))
     (seq? update)
@@ -135,7 +134,7 @@
   [& resource]
   `(fn ~'[route context request response]
      (let ~(apply vector *resource-bindings*)
-       (update-response ~'context ~'response (do ~@resource)))))
+       (update-response ~'response ~'context (do ~@resource)))))

 (defn add-resource
   "Add a resource to the global *resources*."
@@ -145,8 +144,11 @@
           *resources*)))

 (def *default-resource*
-  (pseudo-servlet
-    (str "Path: " full-path)))
+  (pseudo-servlet
+    (let [static-file (file (str "public" sep full-path))]
+      (if (. static-file (isFile))
+        static-file
+        [404 "Cannot find file"]))))

 (defn find-resource
   "Find the first resource that matches the HttpServletRequest"


Edited comment.

Edited comment.

--- src/exploud/info.clj
+++ src/exploud/info.clj
@@ -20,8 +20,8 @@
                         [:description :email :owner]))))

 (defn upsert-application
-  "Upserts an application into Onix, Tyranitar and Asgard. This function can be
-   run many times, it won't fail if the application is present in any of the
+  "Upserts an application into Onix, Tyranitar, Shuppet and Asgard. This function
+   can be run many times, it won't fail if the application is present in any of the
    stores."
   [region application-name details]
   (let [onix-application (onix/upsert-application application-name)


test suite

test suite

--- src/flatgui/test.clj
+++ src/flatgui/test.clj
@@ -66,8 +66,7 @@
   (FGTestAppContainer/createAndInit c-var))

 (defn check-property [container target property expected-value]
-  (let [result (test/is (= expected-value (.getProperty container target property)))]
-    (if (map? result) result)))
+  (test/is (= expected-value (.getProperty container target property))))

 (defn get-property [container target property] (.getProperty container target property))

@@ -82,8 +81,7 @@
                              (inc a)
                              (.getProperty container target property)))
                          v))]
-    (let [result (test/is (pred actual-value))]
-      (if (map? result) result))))
+    (test/is (pred actual-value))))

 ;;
 ;; Mouse
@@ -146,11 +144,21 @@
   ([container str] (.evolve container (create-string-type-events str))))

+;;;
+;;; Utilities for working with components
+;;;
+
 ;;
-;; Utilities for working with components
+;; Table (flatgui.widgets.table2.table)
 ;;

 (defn wait-table-model-coords-shown [container table-path coords]
   (wait-for-property-pred container table-path :in-use-model
                               (fn [v] (let [sc->id (:screen-coord->cell-id v)]
-                                        (= (set coords) (set (map (fn [[k _cid]] k) sc->id)))))))+                                        (= (set coords) (set (map (fn [[k _cid]] k) sc->id)))))))
+
+(defn wait-table-cell-property [container table-path coord property pred]
+  (let [cid (wait-for-property-pred container table-path :in-use-model
+                                    (fn [v] (let [sc->id (:screen-coord->cell-id v)]
+                                              (get sc->id coord))))]
+    (wait-for-property-pred container (conj table-path cid) property pred)))


add model to call to (morph)

add model to call to (morph)

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -22,7 +22,7 @@
    (let [result (generate/generate spec model)]
      (if (keyword? result)
        (throw (Exception. (str "please don't send me a keyword :( : this is what you sent me: " result)))
-       (conj {:surface (morph result)}
+       (conj {:surface (morph result model)}
              result)))))

 ;; can't decide between 'morph' or 'fo' or something other better name.


cleanup: remove unnecessary babel.english/fo - simply use babel.english.morphology/fo instead

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -8,7 +8,7 @@
                                   small-lexicon small-plus-vp-pronoun
                                   small-plus-plus-np
                                   verbcoach]]
-   [babel.english.morphology :as morph]
+   [babel.english.morphology :as morph :refer [fo]]
    [babel.over :refer [over truncate]]
    [babel.parse :as parse]
    [clojure.repl :refer [doc]]
@@ -45,11 +45,6 @@
 (defn lookup [lexeme]
   ((:lookup medium) lexeme))

-(defn fo [expression
-          & {:keys [show-notes]
-             :or {show-notes true}}]
-  (morph/fo expression :show-notes show-notes))
-
 (defn generate
   [spec & {:keys [max-total-depth model truncate-children]
            :or {max-total-depth generate/max-total-depth


default :reflexive should be false

default :reflexive should be false

--- src/babel/italiano.clj
+++ src/babel/italiano.clj
@@ -31,7 +31,24 @@

                          ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
                          transitivize
-
+
+                         ;; if a verb is not specifically marked as reflexive, it
+                         ;; is reflexive:false, to prevent generation of reflexive
+                         ;; sentences using nonreflexive verbs
+                         (map-function-on-map-vals
+                          (fn [k vals]
+                            (map (fn [val]
+                                   (cond (and (= (get-in val [:synsem :cat])
+                                                 :verb)
+                                              (= (get-in val [:synsem :aux])
+                                                 :false)
+                                              (= :none (get-in val [:synsem :sem :reflexive]
+                                                               :none)))
+                                         (unify val {:synsem {:sem {:reflexive false}}})
+                                         true
+                                        val))
+                                 vals)))
+
                          ;; Cleanup functions can go here. Number them for ease of reading.
                          ;; 1. this filters out any verbs without an inflection: infinitive verbs should have inflection ':top',
                          ;; rather than not having any inflection.


reflexive compilation rule should not apply to aux verbs

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -255,7 +255,8 @@
       (default ;; ..but if a verb *is* reflexive:
        (let [subject-semantics (atom {:animate true})
              subject-agr (atom :top)]
-         {:synsem {:cat :verb
+         {:synsem {:aux false
+                   :cat :verb
                    :essere true
                    :sem {:subj subject-semantics
                          :obj subject-semantics


Add example button using set-token

Add example button using set-token

--- examples/frontend/src/frontend/core.cljs
+++ examples/frontend/src/frontend/core.cljs
@@ -10,7 +10,11 @@

 (defn home-page []
   [:div
-   [:h2 "Welcome to frontend"]])
+   [:h2 "Welcome to frontend"]
+   [:button
+    {:type "button"
+     :on-click #(rfe/set-token ::item {:id 3})}
+    "Item 3"]])

 (defn about-page []
   [:div


Document api/thing->prior-versions

Document api/thing->prior-versions

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -62,9 +62,10 @@
   dispatch)

 (defmulti thing->prior-versions
-  "Returns a sequence of things representing itself at earlier or equal
-  versions. Note that this op only supports Versions, Namespaces and
-  Defs. Artifacts and Groups do not have versions."
+  "Succeeds with a result Seq[Thing] representing the argument Thing at earlier
+  or equal versions sorted in decending order. Note that this op only supports
+  Versions, Namespaces and Defs. Artifacts and Groups do not have versions, and
+  will give Failures."

   {:arglists '[[config thing]]}
   dispatch)


Removed filter-with functions

Removed filter-with functions

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -4,10 +4,9 @@
     [clojure.set     :as set]
   ) )

-
 (def show-info-size 10)

-(defn show-info
+(defn show-info
   "Print synopsis info about a sequence of strings"
   [ seqVals seqName ]
   (println


hide-thread is sent to server

hide-thread is sent to server

--- src/chat/client/dispatcher.cljs
+++ src/chat/client/dispatcher.cljs
@@ -19,6 +19,7 @@
     (sync/chsk-send! [:chat/new-message message])))

 (defmethod dispatch! :hide-thread [_ data]
+  (sync/chsk-send! [:chat/hide-thread (data :thread-id)])
   (store/transact! [:users (get-in @store/app-state [:session :user-id]) :hidden-thread-ids] #(conj % (data :thread-id))))


Ensure shutdown-agents in launch-* calls

This could be customized if people want to launch reply multiple times
for some reason.

--- src/clj/reply/main.clj
+++ src/clj/reply/main.clj
@@ -59,7 +59,8 @@
                                                        (slurp ~body))
                             :else (clojure.repl/pst e#)))))
                '(catch Throwable t# (clojure.repl/pst t#))])
-    (finally (say-goodbye))))
+    (finally (say-goodbye)
+             (shutdown-agents))))

 (defn launch-nrepl [options]
   "Launches the nREPL version of REPL-y, with options already parsed out. The
@@ -92,6 +93,5 @@
               (println (.getMessage e))
               (parse-args ["--help"])))]
     (if (:help options)
-      (println banner)
-      (launch options))
-    (shutdown-agents)))
+      (do (println banner) (shutdown-agents))
+      (launch options))))


Modify delete-recursively to fail gracefully for nil root.

--- src/incise/utils.clj
+++ src/incise/utils.clj
@@ -7,7 +7,8 @@
 (defn delete-recursively
   "Delete a directory tree."
   [^File root]
-  (when (.isDirectory root)
-    (doseq [file (remove gitignore-file? (.listFiles root))]
-      (delete-recursively file)))
-  (.delete root))
+  (when root
+    (when (.isDirectory root)
+      (doseq [file (remove gitignore-file? (.listFiles root))]
+        (delete-recursively file)))
+    (.delete root)))


Refactoring.

Refactoring.

--- src/clj/freefrog/governance.clj
+++ src/clj/freefrog/governance.clj
@@ -96,7 +96,7 @@
   "Validate everything about domain manipulation.  Checks that the role name
    is valid and exists.  Also calls the custom validation function.

-  If the validation-fn returns true, throw an error with the given err-msg-fmt.
+  If the validation-fn returns true, throws an error with the given err-msg-fmt.
   err-msg-fmt be in the form of ^.*?%s.*?%s.*$ where the first %s is to be
   replaced with the domain and the second with the role-name."
   (validate-role-updates circle role-name)


Make it more readable

Make it more readable

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -145,9 +145,12 @@
     (fn []
       [:div
        [:input.search-input
-        {:type "text" :placeholder "search"
-         :value @search-text :on-change on-search-enter}]
-       [render-board (filter-by-title @search-text @card-list)]])
+        {:type "text"
+         :placeholder "search"
+         :value @search-text
+         :on-change on-search-enter}]
+       [render-board (filter-by-title @search-text @card-list)]
+      ])
     ))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Get rid of another div indirection

Get rid of another div indirection

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -87,16 +87,17 @@
             comic-imgs @comic-imgs]
         (when (and site
                    location)
-          [:div
-           [:h2 (str "Display chapter " (:chapter location)
-                     " page " (:page location)
-                     " of comic " (:comic location)
-                     " from site " site)]
-           [:br]
-           (when comic-imgs
-             (into [:div]
-                   (map (partial img-component site location)
-                        comic-imgs)))])))))
+          (let [component
+                [:div
+                 [:h2 (str "Display chapter " (:chapter location)
+                           " page " (:page location)
+                           " of comic " (:comic location)
+                           " from site " site)]
+                 [:br]]]
+            (when comic-imgs
+              (into component
+                    (map (partial img-component site location)
+                         comic-imgs)))))))))

 (defn comic-reader []
   (let [page (rf/subscribe [:page])]


Fix mana-color widget

Fix mana-color widget

--- src/cljs/decktouch/widgets.cljs
+++ src/cljs/decktouch/widgets.cljs
@@ -7,7 +7,12 @@
     mana-map))

 (defn get-mana-symbol-counts [cards]
-  (let [mana-costs (reduce str (map #(get % "manaCost") cards))]
+  (let [mana-costs
+         (reduce str
+                 (map
+                   #(reduce str
+                            (repeat (get % "quantity") (get % "manaCost")))
+                   cards))]
     (reduce count-mana-freq {"R" 0 "G" 0 "U" 0 "W" 0 "B" 0} mana-costs)))

 (defn mana-symbol [color number]


Basic drag&drop

Basic drag&drop

--- src/cljs/retroboard/client.cljs
+++ src/cljs/retroboard/client.cljs
@@ -225,11 +225,10 @@
   (let [rect (.getBoundingClientRect node)]
     (and (< (.-left rect) x (+ (.-left rect) (.-width rect)))
          (< (.-top rect) y (+ (.-top rect) (.-height rect))))))
-;this is stupid. use hit boxes
+
 (defn targeted-node [droppable-nodes x y]
   (if-let [drop-node (first (filter #(on-node? % x y) (keys droppable-nodes)))]
     (droppable-nodes drop-node)))
-

 (js/window.addEventListener "mousedown" #(put! mouse-down-ch %))
 (js/window.addEventListener "mouseup"   #(put! mouse-up-ch   %))
@@ -273,40 +272,37 @@
     (async/untap mouse-up-mult up)
     (om/set-state! owner :state nil)))

-(defn perform-drop [connection [drag-type drag-data] [drop-type drop-data]]
-  (case [drag-type drop-type]
-    [:note :column]
-    (when (not= (:column-id drag-data) drop-data)
-      (println "DO IT!")
-      (a/move-note connection (:note drag-data) (:column-id drag-data) drop-data))))
-
-(defn free-drag [owner connection drag-data droppable-nodes]
+(defn free-drag [owner drop-fn droppable-nodes]
   (reify
     IDragStart
     (drag-start [_ event]
       (-drag-start owner event))
     IDragMove
     (drag-move [_ event]
-      (case (om/get-state owner :state)
-        :mousedown
-        (om/set-state! owner :state :dragging)
-        :dragging
-        (let [rel-y (om/get-state owner :rel-y)
-              rel-x (om/get-state owner :rel-x)
-              new-y (- (.. event -pageY) rel-y)
-              new-x (- (.. event -pageX) rel-x)
-              node (om/get-node owner)
-              style (.-style node)]
-          (set! (.-left style) new-x)
-          (set! (.-top style) new-y)
-          (om/set-state! owner :ver-value new-x)
-          (om/set-state! owner :hor-value new-y))
-        nil))
+      (let [rel-y (om/get-state owner :rel-y)
+            rel-x (om/get-state owner :rel-x)
+            new-y (- (.. event -pageY) rel-y)
+            new-x (- (.. event -pageX) rel-x)
+            node (om/get-node owner)
+            style (.-style node)]
+        (set! (.-left style) new-x)
+        (set! (.-top style) new-y)
+        (om/set-state! owner :ver-value new-x)
+        (om/set-state! owner :hor-value new-y))
+      (if (= :mousedown (om/get-state owner :state))
+        (om/set-state! owner :state :dragging)))
     IDragEnd
     (drag-end [_ event]
       (-drag-end owner event)
-      (when-let [drop-data (targeted-node @droppable-nodes (.-pageX event) (.-pageY event))]
-        (perform-drop connection drag-data drop-data)))))
+      (if-let [drop-data (targeted-node @droppable-nodes (.-pageX event) (.-pageY event))]
+        (drop-fn drop-data)))))
+
+
+(defn perform-drop [connection [drag-type drag-data] [drop-type drop-data]]
+  (case [drag-type drop-type]
+    [:note :column]
+    (if (not= (:column-id drag-data) drop-data)
+      (a/move-note connection (:note drag-data) (:column-id drag-data) drop-data))))

 (defn draggable [{:keys [connection comp-fn state drag-data droppable-nodes] :as data} owner opts]
   (reify
@@ -314,7 +310,7 @@
     (init-state [_]
       {:hor-value 0
        :ver-value 0
-       :dragger (free-drag owner connection drag-data droppable-nodes)})
+       :dragger (free-drag owner (partial perform-drop connection drag-data) droppable-nodes)})
     om/IWillMount
     (will-mount [_])
     om/IDidMount
@@ -440,7 +436,8 @@
                                                             :state {:connection connection
                                                                     :column-id id
                                                                     :note note}
-                                                            :drag-data [:note {:column-id id :note (first note)}]}))
+                                                            :drag-data [:note {:column-id id :note (first note)}]}
+                                                 {:key :drag-data}))
                              (sort-by first (:notes column))))
                  (om/build delete-column-button {:connection connection
                                                  :column-id id}))))))
@@ -452,7 +449,6 @@
              (let [error (:error (<! error-chan))]
                (case error
                  :no-such-environment (om/update! app :connected :no-such-environment))))))
-
 (defn view [app owner]
   (reify
     om/IInitState


New keyword parameter in add-san-move and friends.

The functions add-san-move, add-uci-move and add-map-move, as well as
the corresponding add-*-move-sequence functions, now take a new keyword
parameter :remove-existing-moves?. If this parameter is true, the added
move(s) replace any previously existing moves at the point of insertion.

--- src/clojure/clj_chess/game.cljc
+++ src/clojure/clj_chess/game.cljc
@@ -104,38 +104,43 @@
 (defn- zip-add-move
   "Takes a zipper, a move function (a function that, given a board
   and some other value, translates that value to a chess move),
-  and a value representing a move, and returns a new zipper for
-  a modified game tree where the move has been added at the zipper
+  a value representing a move, and a boolean that says whether any previous
+  moves at the current location should be removed, and returns a new zipper
+  for a modified game tree where the move has been added at the zipper
   location."
-  [zipper move-function move]
+  [zipper move-function move remove-existing-moves?]
   (let [board (-> zipper zip/node :board)]
-    (zip/append-child zipper
+    (zip/append-child (if remove-existing-moves?
+                        (zip-remove-children zipper)
+                        zipper)
                       {:board (board/do-move board
                                              (move-function board move))
                        :node-id (generate-id)})))

-(def ^:private zip-add-san-move #(zip-add-move %1 board/move-from-san %2))
-(def ^:private zip-add-uci-move #(zip-add-move %1 board/move-from-uci %2))
-(def ^:private zip-add-plain-move #(zip-add-move %2 (fn [_ m] m) %2))
+(def ^:private zip-add-san-move #(zip-add-move %1 board/move-from-san %2 false))
+(def ^:private zip-add-uci-move #(zip-add-move %1 board/move-from-uci %2 false))
+(def ^:private zip-add-plain-move #(zip-add-move %2 (fn [_ m] m) %2 false))

 (defn- zip-add-move-sequence
   "Takes a zipper, a move function (a function that, given a board and some
-  other value, translates that value to a chess move), and a sequence of
-  values representing chess moves, and returns a new zipper for a modified
-  game tree where the moves have been added at the zipper location."
-  [zipper move-function moves]
+  other value, translates that value to a chess move), a sequence of
+  values representing chess moves, and a boolean that says whether any
+  previous moves at the current node should be removed, and returns a new
+  zipper for a modified game tree where the moves have been added at the
+  zipper location."
+  [zipper move-function moves remove-existing-moves?]
   (reduce (fn [z m]
-            (-> (zip-add-move z move-function m)
+            (-> (zip-add-move z move-function m remove-existing-moves?)
                 (zip/down)
                 (zip/rightmost)))
           zipper
           moves))

 (def ^:private zip-add-san-move-sequence
-  #(zip-add-move-sequence %1 board/move-from-san %2))
+  #(zip-add-move-sequence %1 board/move-from-san %2 false))

 (def ^:private zip-add-uci-move-sequence
-  #(zip-add-move-sequence %2 board/move-from-uci %2))
+  #(zip-add-move-sequence %2 board/move-from-uci %2 false))

 (defn- zip-add-key-value-pair
   [zipper key value]
@@ -151,13 +156,13 @@
 (defn add-move
   "Takes a game, a move function (a function that, given a board and
   some other value, translates that value to a chess move), a
-  a value representing a move, and an optional node id as input, and
-  returns an updated game where the move has been added as the last
-  child at the given node. If no node id is supplied, the current node
-  of the game is used."
-  [game move-function move node-id]
+  a value representing a move, a node id, and a boolean that says whether the
+  existing moves at the current nodes should be removed, and returns an
+  updated game where the move has been added as the last child at the given
+  node. If no node id is supplied, the current node of the game is used."
+  [game move-function move node-id remove-existing-moves?]
   (let [z (-> (game-zip game node-id)
-              (zip-add-move move-function move)
+              (zip-add-move move-function move remove-existing-moves?)
               zip/down
               zip/rightmost)]
     (assoc game :root-node (zip/root z)
@@ -167,37 +172,45 @@
 (defn add-san-move
   "Adds a move in short algebraic notation to a game at a given node
   id. The move is added as the last child. If no node id is supplied,
-  the current node of the game is used."
-  [game san-move & {:keys [node-id]}]
+  the current node of the game is used. If remove-existing-moves? is true,
+  any previously existing moves at the point of insertion are removed."
+  [game san-move & {:keys [node-id remove-existing-moves?]}]
   (add-move game board/move-from-san san-move
-            (or node-id (-> game :current-node :node-id))))
+            (or node-id (-> game :current-node :node-id))
+            remove-existing-moves?))

 (defn add-uci-move
   "Adds a move in UCI notation to a game at a given node id. The move is
   added as the last child. If no node id is supplied, the current node of the
-  game is used."
-  [game uci-move & {:keys [node-id]}]
+  game is used. If remove-existing-moves? is true, any previously existing
+  moves at the point of insertion are removed."
+  [game uci-move & {:keys [node-id remove-existing-moves?]}]
   (add-move game board/move-from-uci uci-move
-            (or node-id (-> game :current-node :node-id))))
+            (or node-id (-> game :current-node :node-id))
+            remove-existing-moves?))

 (defn add-map-move
   "Adds a map move (see documentation for clj-chess.board/board-to-map) to a
   game at a given node id. The move is added as the last child. If no node id
-  is supplied, the current node of the game is used."
-  [game map-move & {:keys [node-id]}]
+  is supplied, the current node of the game is used. If remove-existing-moves?
+  is true, any previously existing moves at the point of insertion are removed."
+  [game map-move & {:keys [node-id remove-existing-moves?]}]
   (add-move game board/move-from-map map-move
-            (or node-id (-> game :current-node :node-id))))
+            (or node-id (-> game :current-node :node-id))
+            remove-existing-moves?))

 (defn add-move-sequence
   "Like add-move, but adds a sequence of moves rather than a single move. This
   is faster than calling add-move multiple times, because we don't have to
-  unzip and zip the tree for each added move."
-  [game move-function moves node-id]
+  unzip and zip the tree for each added move. If remove-existing-moves? is
+  true, any previously existing moves at the point of insertion are removed."
+  [game move-function moves node-id remove-existing-moves?]
   (let [z (-> (game-zip game node-id)
-              (zip-add-move-sequence move-function moves))]
+              (zip-add-move-sequence move-function moves
+                                     remove-existing-moves?))]
     (assoc game :root-node (zip/root z)
                 :current-node (zip/node z))))

@@ -205,19 +218,25 @@
 (defn add-san-move-sequence
   "Like add-san-move, but adds a sequence of moves rather than a single move.
   This is faster than calling add-san-move multiple times, because we don't
-  have to unzip and zip the tree for each added move."
-  [game san-moves & {:keys [node-id]}]
+  have to unzip and zip the tree for each added move. If
+  remove-existing-moves? is true, any previously existing moves at the point
+  of insertion are removed."
+  [game san-moves & {:keys [node-id remove-existing-moves?]}]
   (add-move-sequence game board/move-from-san san-moves
-                     (or node-id (-> game :current-node :node-id))))
+                     (or node-id (-> game :current-node :node-id))
+                     remove-existing-moves?))

 (defn add-uci-move-sequence
   "Like add-uci-move, but adds a sequence of moves rather than a single move.
   This is faster than calling add-uci-move multiple times, because we don't
-  have to unzip and zip the tree for each added move."
-  [game uci-moves & {:keys [node-id]}]
+  have to unzip and zip the tree for each added move. If
+  remove-existing-moves? is true, any previously existing moves at the point
+  of insertion are removed."
+  [game uci-moves & {:keys [node-id remove-existing-moves?]}]
   (add-move-sequence game board/move-from-uci uci-moves
-                     (or node-id (-> game :current-node :node-id))))
+                     (or node-id (-> game :current-node :node-id))
+                     remove-existing-moves?))

 (defn add-key-value-pair


Added code to index source files by type.

--- src/alfresco_technical_validation/source_indexer.clj
+++ src/alfresco_technical_validation/source_indexer.clj
@@ -31,16 +31,16 @@

 (defn- build-file-type-index
   [files file-regex k]
-  { k (filter #(re-matches file-regex %) files) })
+  { k (filter #(re-matches file-regex (.getName %)) files) })

 (defn- build-file-types-index
   [files]
-  (merge (map #(build-file-type-index files % (val %)) file-types-of-interest)))
+  (into {} (map #(build-file-type-index files (key %) (val %)) file-types-of-interest)))

 (defn index-source
   "Indexes the source code in the given location."
   [source]
-  (let [files (file-seq (io/file source))
-        ]
+  (let [files      (file-seq (io/file source))
+        file-index (build-file-types-index files)]
     (comment "####TODO: implement me!")
     ))


Auto scrolling of chat boxes.

Auto scrolling of chat boxes.

--- src/cljs/wombats_web_client/components/chat_box.cljs
+++ src/cljs/wombats_web_client/components/chat_box.cljs
@@ -48,19 +48,29 @@
   [messages stats]
   (fn []
     (let [stats @stats
-          messages @messages]
-      [:ul {:class-name "chat-box-message-container"}
-       (if (pos? (count messages))
-         (for [{:keys [username
-                       message
-                       timestamp]} messages]
-           ^{:key (str username "-" timestamp)}
-           [:li {:class-name "chat-msg"}
-            [:span {:class-name "msg-timestamp"} (format-time timestamp)]
-            [:span {:class-name "msg-username"
-                    :style {:color (get-username-color stats username)}} username]
-            [:span {:class-name "msg-body"} message]])
-         [default-message])])))
+          messages @messages
+          element (first (array-seq (.getElementsByClassName js/document
+                                                             "chat-box-message-container")))]
+
+      ;; Check if you should auto scroll to the bottom
+      (when (and element (= (+ element.scrollTop element.clientHeight) element.scrollHeight))
+        ;; On the next tick, scroll the rendered element down
+        (js/setTimeout #(set! (.-scrollTop element)
+                              element.scrollHeight)
+                       0))
+
+       [:ul {:class-name "chat-box-message-container"}
+        (if (pos? (count messages))
+          (for [{:keys [username
+                        message
+                        timestamp]} messages]
+            ^{:key (str username "-" timestamp)}
+            [:li {:class-name "chat-msg"}
+             [:span {:class-name "msg-timestamp"} (format-time timestamp)]
+             [:span {:class-name "msg-username"
+                     :style {:color (get-username-color stats username)}} username]
+             [:span {:class-name "msg-body"} message]])
+          [default-message])])))

 (defn chat-box-input
   [game-id]


Introduce CLJSDevtoolsFormatter type

Introduce CLJSDevtoolsFormatter type

--- src/devtools/core.cljs
+++ src/devtools/core.cljs
@@ -8,13 +8,10 @@
 (def ^:dynamic *monitor-enabled* false)

 (def formatter-key "devtoolsFormatters")
-(def api-marker "cljs_devtools_handler")

-(def api-mapping [["header" format/header-api-call]
-                  ["hasBody" format/has-body-api-call]
-                  ["body" format/body-api-call]])
+(deftype CLJSDevtoolsFormatter [header hasBody body])

-(defn monitor-api-calls [name api-call]
+(defn- monitor-api-calls [name api-call]
   (fn [value]
     (if-not *monitor-enabled*
       (api-call value)                                      ; raw API call
@@ -27,7 +24,7 @@
           (debug/unindent!)
           api-response)))))

-(defn sanitize
+(defn- sanitize
   "wraps our api-call in try-catch block to prevent leaking of exceptions if something goes wrong"
   [_ api-call]
   (fn [value]
@@ -39,51 +36,48 @@
           (debug/log-exception e)
           nil)))))

-(defn cljs-formatter []
+(defn- build-cljs-formatter []
   (let [api-call-wrapper (fn [name api-call]
                            (let [monitor (partial monitor-api-calls name)
                                  sanitizer (partial sanitize name)]
-                             ((comp monitor sanitizer) api-call)))
-        api-gen (fn [[name api-call]] [name (api-call-wrapper name api-call)])]
-    (apply js-obj (mapcat #(api-gen %) api-mapping))))
+                             ((comp monitor sanitizer) api-call)))]
+    (CLJSDevtoolsFormatter.
+      (api-call-wrapper "header" format/header-api-call)
+      (api-call-wrapper "hasBody" format/has-body-api-call)
+      (api-call-wrapper "body" format/body-api-call))))

-(defn- is-marked? [o]
-  (boolean (aget o api-marker)))
+(defn- is-ours? [o]
+  (instance? CLJSDevtoolsFormatter o))

-(defn- mark! [o]
-  (aset o api-marker true)
-  o)
-
-(defn- safe-get-formatters []
+(defn- get-formatters-safe []
   (let [formatters (aget js/window formatter-key)]
     (if (array? formatters)                                 ; TODO: maybe issue a warning if formatters are anything else than array or nil
       formatters
       #js [])))

 (defn- installed? []
-  (let [formatters (safe-get-formatters)]
-    (boolean (some is-marked? formatters))))
+  (let [formatters (get-formatters-safe)]
+    (boolean (some is-ours? formatters))))

-(defn- install-marked-formatter! [formatter]
-  (let [formatters (.slice (safe-get-formatters))]          ; slice effectively duplicates the array
+(defn- install-our-formatter! [formatter]
+  (let [formatters (.slice (get-formatters-safe))]          ; slice effectively duplicates the array
     (.push formatters formatter)                            ; acting on duplicated array
     (aset js/window formatter-key formatters)))

-(defn- uninstall-marked-formatters! []
-  (let [formatters (safe-get-formatters)
-        new-formatters (remove is-marked? (vec formatters))
-        new-formatters-value (if (empty? new-formatters) nil (into-array new-formatters))]
-    (aset js/window formatter-key new-formatters-value)))
+(defn- uninstall-our-formatters! []
+  (let [new-formatters (remove is-ours? (vec (get-formatters-safe)))
+        new-formatters-js (if (empty? new-formatters) nil (into-array new-formatters))]
+    (aset js/window formatter-key new-formatters-js)))

 (defn install! []
   (if (installed?)
     (debug/log-info "devtools already installed - nothing to do")
-    (install-marked-formatter! (mark! (cljs-formatter)))))
+    (install-our-formatter! (build-cljs-formatter))))

 (defn uninstall! []
   (if-not (installed?)
     (debug/log-info "devtools not installed - nothing to do")
-    (uninstall-marked-formatters!)))
+    (uninstall-our-formatters!)))

 (defn disable! []


Cleanup

Cleanup

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -1,8 +1,7 @@
 (ns expound.alpha
   "Drop-in replacement for clojure.spec.alpha, with
   human-readable `explain` function"
-  (:require [clojure.data]
-            [clojure.spec.alpha :as s]
+  (:require [clojure.spec.alpha :as s]
             [clojure.string :as string]
             [clojure.walk :as walk]
             #?(:cljs [goog.string.format])
@@ -293,7 +292,7 @@
      ;; FIXME - this duplicates the structure of how
      ;; spec builds the 'contains?' function. Extract this into spec
      ;; and use conform instead of this ad-hoc validation.
-     :clj (let [[fn _ [contains _arg key-keyword] & rst] form]
+     :clj (let [[_fn _ [contains _arg key-keyword] & _rst] form]
             (s/assert #{'clojure.core/contains?} contains)
             key-keyword)))

@@ -343,7 +342,7 @@
      (let [pred (:pred problem)]
        (and (seq? pred)
             (map? (:val problem))
-            (let [[fn _ [contains _] & rst] pred]
+            (let [[fn _ [contains _] & _rst] pred]
               (and
                (= 'clojure.core/fn fn)
                (= 'clojure.core/contains? contains)))))))


expode debug command line flag

expode debug command line flag

--- src/matross/core.clj
+++ src/matross/core.clj
@@ -19,7 +19,8 @@
 (def cli-opts
   [["-h" "--help"]
    ["-s" "--ask-password"]
-   ["-S" "--ask-sudo-pass"]])
+   ["-S" "--ask-sudo-pass"]
+   ["-d" "--debug"]])

 (defn display-help []
   (prn "matross!"))


More silencing of caching warnings

More silencing of caching warnings

--- src/frontend/proxy.clj
+++ src/frontend/proxy.clj
@@ -45,7 +45,10 @@
                     (dissoc "date")
                     ;; The production server insists on secure cookies, but
                     ;; the development proxy does not support SSL.
-                    strip-secure)]
+                    strip-secure
+                    ;; Silence pagespeed warnings
+                    (assoc "Vary" "Accept-Encoding"))]
+
     {:status status
      :headers headers
      :body body}))


Removing url unsafe characters from the base64 hash.

--- src/gmail_clj/core.clj
+++ src/gmail_clj/core.clj
@@ -134,7 +134,9 @@

 (defn str->b64 [input]
   (let [input (if (bytes? input) input (.getBytes input))]
-    (String. (b64/encode input) "UTF-8")))
+    (-> (String. (b64/encode input) "UTF-8"))
+        (.replaceAll "\\+" "-")
+        (.replaceAll "/" "_")))

 (defn b64->str [input]
   (let [input (if (bytes? input) input (.getBytes input))]


Prune some of the sample data links

Prune some of the sample data links

The graph looks too crowded. Remove many of the links from the sample
data.

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -246,9 +246,9 @@
            ;; Running do-layout! modifies the link data to contain full nodes
            ;;  rather than indices. Hence this ugly ordering.
            (let [data-links (js->clj (aget raw-data "links"))
-                 links (mapv (fn [data-link]
-                               (link (data-link "source") (data-link "target")))
-                             data-links)]
+                 links (->> data-links
+                            (filter #(>= (% "value") 4))
+                            (mapv (fn [l] (link (l "source") (l "target")))))]
              (do-layout! raw-data)
              (let [data-nodes (js->clj (aget raw-data "nodes"))
                    nodes (mapv (fn [data-node]


moved the docstring before the parameter list

--- src/greybear/model.clj
+++ src/greybear/model.clj
@@ -100,9 +100,10 @@
     (when (:stones game)
       (update-in game [:stones] #(map char %)))))

-(defn last-move [game-id]
+(defn last-move
   "Return a map like {:player BLACK :x 4 :y 5}
   Returns nil when there is no last move"
+  [game-id]
   (let [move (first (select moves
                             (where {:game_id game-id})
                             (order :ordinal :DESC)


Add function to cut a triangle from an image

The function cuts out a triangle from one of the four corners, and leaves the
other half of the image transparent.

--- src/fivetonine/collage/core.clj
+++ src/fivetonine/collage/core.clj
@@ -23,6 +23,7 @@
   (:import java.awt.geom.AffineTransform)
   (:import java.awt.AlphaComposite)
   (:import java.awt.Color)
+  (:import java.awt.Polygon)
   (:import java.awt.RenderingHints))

 (declare resize*)
@@ -241,6 +242,35 @@
       .dispose)
     circle))

+(defn- triangle-polygon [pos ^long w]
+  (case pos
+    :lower-left (Polygon. (int-array [0 w 0]) (int-array [w w 0]) 3)
+    :lower-right (Polygon. (int-array [w w 0]) (int-array [w 0 w]) 3)
+    :upper-right (Polygon. (int-array [w 0 w]) (int-array [0 0 w]) 3)
+    :upper-left (Polygon. (int-array [0 0 w]) (int-array [0 w 0]) 3)))
+
+(defn triangle
+  "Crop a triangle from an image, leaving a transparent background. Can optionally
+  be called with an option map that specifies where the triangle is positioned:
+
+  ```clj
+  (triangle image {:position :upper-left})
+  (triangle image {:position :lower-left})
+  (triangle image {:position :lower-right})
+  (triangle image {:position :upper-right})
+  ```"
+  [^BufferedImage image & [{:keys [position]}]]
+  (let [width (.getWidth image)
+        triangle (BufferedImage. width width BufferedImage/TYPE_INT_ARGB)]
+    (doto (.createGraphics triangle)
+      (.setComposite AlphaComposite/Clear)
+      (.fillRect 0 0 width width)
+      (.setComposite AlphaComposite/Src)
+      (.setClip (triangle-polygon (or position :upper-left) width))
+      (.drawImage image 0 0 width width nil)
+      .dispose)
+    triangle))
+
 (defmacro with-image
   "A helper for applying multiple operations to an image.


Modified defproject to emit unquoted forms verbatim.

This means they are evaluated at runtime. See #49.

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -1,17 +1,27 @@
 (ns leiningen.core
   (:use [clojure.contrib.with-ns]
-        [clojure.contrib.find-namespaces :only [find-namespaces-on-classpath]])
+        [clojure.contrib.find-namespaces :only [find-namespaces-on-classpath]]
+        [clojure.walk :only [walk]])
   (:import [java.io File])
   (:gen-class))

 (def project nil)
+
+(defn- munge-project-args [args]
+  (walk (fn inner-munge [item]
+          (cond (and (seq? item)
+                     (= `unquote (first item))) (second item)
+                     (symbol? item) (list 'quote item)
+                     :else (munge-project-args item)))
+        identity
+        args))

 (defmacro defproject [project-name version & args]
   ;; This is necessary since we must allow defproject to be eval'd in
   ;; any namespace due to load-file; we can't just create a var with
   ;; def or we would not have access to it once load-file returned.
   `(do
-     (let [m# (apply hash-map (quote ~args))
+     (let [m# (apply hash-map ~(cons 'list (munge-project-args args)))
            root# ~(.getParent (java.io.File. *file*))]
        (alter-var-root #'project
                        (fn [_#] (assoc m#


use exit-with-error instead of printing an error message and calling System/exit separately every time

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -34,6 +34,10 @@
 ;; So it doesn't need to be fully-qualified in project.clj
 (with-ns 'clojure.core (use ['leiningen.core :only ['defproject]]))

+(defn exit-with-error [msg]
+  (println msg)
+  (System/exit 1))
+
 ;; TODO: prompt to run "new" if no project file is found
 (defn read-project
   ([file] (load-file file)
@@ -45,20 +49,19 @@

 (def no-project-needed #{"new" "help" "version"})

-(defn task-not-found [task project & _]
-  (println task "is not a task. Use \"help\" to list all tasks.")
-  (System/exit 1))
-
 (defn resolve-task [task]
   (let [task-ns (symbol (str "leiningen." task))
         task (symbol task)
-        not-found-fn (partial task-not-found task)]
+        error-fn (fn [& _]
+                   (exit-with-error
+                     (format "%s is not a task. Use \"help\" to list all tasks."
+                             task)))]
     (try
      (require task-ns)
      (or (ns-resolve task-ns task)
-         not-found-fn)
+         error-fn)
      (catch java.io.FileNotFoundException e
-       not-found-fn))))
+       error-fn))))

 (defn -main [& [task & args]]
   (let [task (or (aliases task) task "help")
@@ -71,7 +74,7 @@
       (try
        (apply (resolve-task task) args)
        (catch IllegalArgumentException _
-         (println (format "Wrong number of arguments to task %s." task))
-         (System/exit 1))))
+         (exit-with-error (format "Wrong number of arguments to task %s."
+                                  task)))))
     ;; In case tests or some other task started any:
     (shutdown-agents)))


Consolidate repetition in 'box-repo-add for clarity.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -586,19 +586,15 @@
     (let [pname (-> (str proj)
                     (s/replace #"/" "--"))
           pdir (adj-path bdir pname)
-          checkout (adj-path bdir (str ".voom-box/" pname))]
+          checkout (adj-path bdir (str ".voom-box/" pname))
+          g {:gitdir (adj-path checkout "/.git")}
+          remote (-> (remotes gitdir) :origin :fetch)]
       (if (.exists ^File checkout)
-        (git {:gitdir (adj-path checkout "/.git")}
-             "fetch")
-        (git {} "clone" (-> (remotes gitdir) :origin :fetch)
-             "--refer" gitdir
-             checkout))
-      (git {:gitdir (adj-path checkout "/.git")}
-           "checkout" sha) ; must detach head for update...
-      (git {:gitdir (adj-path checkout "/.git")}
-           "branch" "-f" branch sha)
-      (git {:gitdir (adj-path checkout "/.git")}
-           "checkout" branch)
+        (git g "fetch")
+        (git {} "clone" remote "--refer" gitdir checkout))
+      (git g "checkout" sha) ; must detach head for update...
+      (git g "branch" "-f" branch sha)
+      (git g "checkout" branch)
       (sh "rm" "-f" pdir)
       ;; (SYMLINK WILL NEED TO BE UPDATED FOR EACH CHECKOUT)
       (sh "ln" "-s" (adj-path checkout path) pdir))


Add update-repo-dbs subtask

Add update-repo-dbs subtask

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1096,6 +1096,13 @@
       (write-git-db db gitdir))
     db))

+(defn update-repo-dbs
+  "Update voom dbs for all git repos in $VOOM_REPOS.
+
+  Example: lein voom update-repo-dbs"
+  [_]
+  (time (p-repos (fn [p] (updated-git-db p)))))
+
 (def obj-patho
   (l/tabled [tree-sha so-far fname ftype fsha tree-path]
    (l/conde
@@ -1207,7 +1214,7 @@

 (def subtasks [#'build-deps #'deploy #'find-box #'freshen #'install
-               #'retag-all-repos #'ver-parse #'wrap])
+               #'retag-all-repos #'update-repo-dbs #'ver-parse #'wrap])

 (def internal-subtasks [#'box #'box-new #'box-init #'box-add #'box-remove])


Clone repos not from ~/.voom-repos but from their origins.

Also removed an extra debug line.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -592,11 +592,10 @@
                     (s/replace #"/" "--"))
           pdir (adj-path bdir pname)
           checkout (adj-path bdir (str ".voom-box/" pname))]
-      (println "Found box at:" bdir pdir)
       (if (.exists ^File checkout)
         (git {:gitdir (adj-path checkout "/.git")}
              "fetch")
-        (git {} "clone" gitdir
+        (git {} "clone" (-> (remotes gitdir) :origin :fetch)
              "--refer" gitdir
              checkout))
       (git {:gitdir (adj-path checkout "/.git")}


made hiding issues with labels configurable

--- src/gh_waiting_room/service.clj
+++ src/gh_waiting_room/service.clj
@@ -6,6 +6,7 @@
               [io.pedestal.service.interceptor :refer [defon-response]]
               [clostache.parser :refer [render-resource]]
               [tentacles.issues :refer [my-issues]]
+              clojure.string
               [ring.util.response :as ring-resp]))

 (def db (atom {}))
@@ -22,15 +23,21 @@
                       (or (System/getenv "GITHUB_ISSUE_REGEX")
                           (str "github.com/" gh-user))))

+(def gh-hide-labels (when-let [labels (System/getenv "GITHUB_HIDE_LABELS")]
+                      (clojure.string/split labels #"\s*,\s*")))
+
 (defn- api-options
   []
   (merge {:filter "all" :all-pages true} gh-auth))

-;; TODO: make this customizable
 (defn- issue-filter
   [issue]
   (and (re-find issue-url-regex (str (:html_url issue)))
-       (= [] (:labels issue))))
+       (if gh-hide-labels
+         (not (some
+               (set gh-hide-labels)
+               (map :name (:labels issue))))
+         (= [] (:labels issue)))))

 (defn- fetch-gh-issues
   []


Remove the main client update ID from the global state.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -136,21 +136,19 @@
 (log/set-configuration! {"" :debug })

 (defn update-current-time []
-  (log/debug "update-current-time")
-  (reset! current-time (time/now)))
+  (let [t (time/now)]
+    (log/debug "update-current-time: " t)
+    (reset! current-time t)))
+
+(defonce update-interval-id
+  (js/setInterval update-current-time update-interval-ms))

 (defn ^:export run []
-  (reagent/render [dashboard]
-                  (js/document.getElementById "metlog"))
+  (reagent/render [dashboard] (js/document.getElementById "metlog"))
   (.addEventListener js/window "resize" on-window-resize)
-  (let [update-interval-id
-        (or (:update-interval-id @dashboard-state)
-            (js/setInterval update-current-time update-interval-ms))]
-    (swap! dashboard-state merge {:update-interval-id update-interval-id})
-
-    (server/fetch-series-names #(swap! dashboard-state merge {:all-series %}))
-    (server/fetch-dashboard-series #(swap! dashboard-state merge {:displayed-series %}))
-    (log/debug "init complete.")))
+  (server/fetch-series-names #(swap! dashboard-state merge {:all-series %}))
+  (server/fetch-dashboard-series #(swap! dashboard-state merge {:displayed-series %}))
+  (log/debug "init complete. update-interval-id:" update-interval-id))

 (run)


println

println

--- api/test/clojure/org/akvo/flow_api/sync.clj
+++ api/test/clojure/org/akvo/flow_api/sync.clj
@@ -43,8 +43,6 @@
      (unilog/after-forms-loaded r (apply can-see (:forms-to-load r)))))
   ([events perms]
    (let [r (unilog/process-new-events-pure events)]
-     (println r)
-     (println (unilog/after-forms-loaded r perms))
      (unilog/after-forms-loaded r perms))))

 (def form-instance-changes (comp :form-instances-to-load changes-with-permissions))


Fix refactor bug

Fix refactor bug

--- src/qcast/server.clj
+++ src/qcast/server.clj
@@ -68,7 +68,7 @@
      (itunes/block false)
      (itunes/explicit false)]))

-(defn- serve-feed [media req]
+(defn- serve-feed [media]
   (let [entries (map :data (cache/latest 50))
         items (map #(feed-item media %) entries)
         channel (feed-channel (:publish-date (first entries)))


docstring & made match-index private

docstring & made match-index private

--- src/questdb/core.clj
+++ src/questdb/core.clj
@@ -161,7 +161,7 @@
      (for [uuid uuids]
        (get-doc dbname uuid))))

-(defn match-index
+(defn- match-index
   [dbname kv]
   (cond (some #(= :or %) (keys kv))
         (apply cs/union
@@ -286,6 +286,7 @@
           (del-file!! dbname doc-or-uuid)))))

 (defn del-docs!!
+  "Delete multiple docs given in the list of docs or uuids"
   [dbname docs-or-uuids]
   (doseq [datum docs-or-uuids]
     (del-doc!! dbname datum)))


Remove unnecessary code

Remove unnecessary code

--- src/photon/streams.clj
+++ src/photon/streams.clj
@@ -237,122 +237,6 @@
       (sub (:p (publisher a-stream)) stream-name ch))
     ch))

-#_(def test-ch (chan))
-#_(def mongo-ds (->DummyStream (m/make-connection "photon") test-ch (mult test-ch)))
-#_(def test-ds (->AsyncStream (db/riak "rxriak-events-v1")
-                            test-ch (mult test-ch)))
-
 (defn new-async-stream [db]
   (->AsyncStream db))

-#_(defn transfer! []
-  (let [ch (stream mongo-ds {"stream-type" "cold" "from" "0"})]
-    (go
-      (loop [elem (<! ch)]
-        (if (nil? elem)
-          (println "Finished!")
-          (do
-            (println "Processing " (.hashCode elem))
-            (process-event! test-ds (dissoc elem :_id))
-            (recur (<! ch))))))))
-
-#_(stream mongo-ds {"stream-type" "cold" "from" "0" :limit 5})
-#_(db/store (db/riak "rxriak-events-v1") "events" "event" {:b 2})
-#_(Thread/sleep 5000)
-#_(db/lazy-events-page (db/riak "rxriak-events-v1") "events" "0" 1)
-
-#_(defn test-query []
-   (register-query! mongo-ds :test-query-3
-                    (sfn/fn [prev item]
-                      (let [agg-unit 604800000 #_86400000
-                            ua (try
-                                 (uap/lookup-useragent (:user-agent (:headers item)))
-                                 (catch Exception e {}))
-                            payload (:payload item)
-                            event-name (:commandName item)
-                            action-name (:name item)
-                            entity-type (:type (:parameters item))
-                            path [(:method item) (:url item)]
-                            timestamp (:server_timestamp item)
-                            interval (* (int (/ timestamp agg-unit)) agg-unit)
-                            username (:username payload)]
-                        {:oses (assoc (:oses prev)
-                                      (:family (:os ua))
-                                      (inc (get (:oses prev)
-                                                (:family (:os ua)) 0)))
-                         :browsers (assoc (:browsers prev)
-                                          (:family (:browser ua))
-                                          (inc (get (:browsers prev)
-                                                    (:family (:browser ua)) 0)))
-                         :actions (assoc-in (:actions prev)
-                                            [interval action-name]
-                                            (inc (get-in (:actions prev)
-                                                         [interval action-name]
-                                                         0)))
-                         :paths (assoc-in (:paths prev)
-                                          [interval path]
-                                          (inc (get-in (:paths prev)
-                                                       [interval path]
-                                                       0)))
-                         :events (assoc-in (:events prev)
-                                           [interval event-name]
-                                           (inc (get-in (:events prev)
-                                                        [interval event-name]
-                                                        0)))
-                         :profiles (if (or (nil? username)
-                                           (not (contains? payload :id)))
-                                     (:profiles prev)
-                                     (assoc (:profiles prev) username
-                                            (merge (get (:profiles prev)
-                                                        username {})
-                                                   payload)))
-                         :all-skills (if (contains? payload :skills)
-                                       (into #{} (concat (:all-skills prev)
-                                                         (:skills payload)))
-                                       (:all-skills prev))
-                         :non-skills (assoc (:non-skills prev)
-                                            interval
-                                            (count
-                                              (if (contains? payload :skills)
-                                                (into #{} (:skills payload))
-                                                [])))
-                         :skills-intervals (assoc (:skills-intervals prev)
-                                                  interval
-                                                  (count
-                                                    (if (contains? payload :skills)
-                                                      (into #{} (concat (:all-skills prev)
-                                                                        (:skills payload)))
-                                                      (:all-skills prev))))
-                         :intervals (if (or (not (= event-name "login-success"))
-                                            (nil? username))
-                                      (:intervals prev)
-                                      (assoc-in (:intervals prev)
-                                                [interval username]
-                                                (inc (get-in (:intervals prev)
-                                                             [interval username]
-                                                             0))))}))
-                    {:browsers {}
-                     :devices {}
-                     :oses {}
-                     :all-skills {}
-                     :skills-intervals {}
-                     :non-skills {}
-                     :logins {}
-                     :intervals {}
-                     :events {}
-                     :actions {}
-                     :paths {}
-                     :profiles {}}))
-
-#_(db/store riak-streams "streams" "stream" {:stream "events"})
-
-#_(def test-s (stream {"stream-type" "cold"}))
-#_(go (loop [e (<! test-s)] (println (nil? e)) (if (nil? e) (println "Finished") (do (println e) (recur (<! test-s))))) (println "Done"))
-#_(close! test-s)
-
-#_(Thread/sleep 10000)
-
-#_(def test-s (stream {"stream-type" "hot"}))
-#_(go (loop [e (<! test-s)] (println (nil? e)) (if (nil? e) (println "Finished") (do (println e) (recur (<! test-s))))) (println "Done"))
-#_(go (loop [i 1000] (if (= 0 i) (println "Source finished") (>! tube {:value i})) (recur (dec i))))
-


Fix project name pattern

Fix project name pattern


Undo - merge changes incorrectly pushed to master. - reinstate use of ratoms. - correct extracted undo/redo counts.

--- src/re_frame/undo.cljs
+++ src/re_frame/undo.cljs
@@ -3,7 +3,7 @@
   (:require
     [reagent.core      :as     reagent]
     [re-frame.db       :refer  [app-db]]
-    [re-frame.handlers :as     handlers ]
+    [re-frame.handlers :as     handlers]
     [re-frame.subs     :as     subs ]))

@@ -16,8 +16,8 @@
   (reset! max-undos n))

 ;;
-(def ^:private undo-list (atom []))   ;; a list of history states
-(def ^:private redo-list (atom []))   ;; a list of future states, caused by undoing
+(def ^:private undo-list (reagent/atom []))   ;; a list of history states
+(def ^:private redo-list (reagent/atom []))   ;; a list of future states, caused by undoing

 (defn clear-history!
@@ -34,13 +34,13 @@
                            @max-undos
                            (conj @undo-list @app-db)))))

-(defn- undos?
-  [v]
-  (> (count v) 1))
+(defn undos?
+  []
+  (>= (count @undo-list) 1))

-(defn- redos?
-  [v]
-  (> (count v) 0))
+(defn redos?
+  []
+  (> (count @redo-list) 0))

 ;; -- subscriptions  -----------------------------------------------------------------------------
@@ -50,14 +50,14 @@
   (fn handler
     ; "return true if anything is stored in the undo list, otherwise false"
     [_ _]
-    (reaction (undos? @undo-list))))
+    (reaction (undos?))))

 (subs/register
   :redos?
   (fn handler
     ; "return true if anything is stored in the redo list, otherwise false"
     [_ _]
-    (reaction (redos? @redo-list))))
+    (reaction (redos?))))

 ;; -- event handlers  ----------------------------------------------------------------------------


riemann.streams: clean up use/require

riemann.streams: clean up use/require

--- src/riemann/config.clj
+++ src/riemann/config.clj
@@ -4,54 +4,54 @@
   config. Provides a default core and functions ((tcp|udp)-server, streams,
   index, reinject) which operate on that core."
   (:import (java.io File))
-  (:require [riemann.core :as core]
-            [riemann.common :as common :refer [event]]
-            [riemann.service :as service]
-            [riemann.transport.tcp        :as tcp]
-            [riemann.transport.udp        :as udp]
-            [riemann.transport.websockets :as websockets]
-            [riemann.transport.sse        :as sse]
-            [riemann.transport.graphite   :as graphite]
-            [riemann.transport.opentsdb   :as opentsdb]
-            [riemann.logging :as logging]
-            [riemann.folds :as folds]
-            [riemann.pubsub :as pubsub]
-            [riemann.graphite :as graphite-client]
-            [riemann.logstash :as logstash-client]
+  (:require [riemann [boundary    :refer [boundary]]
+                     [campfire    :refer [campfire]]
+                     [client      :refer [udp-client tcp-client multi-client]]
+                     [cloudwatch  :refer [cloudwatch]]
+                     [common      :as common :refer [event]]
+                     [core        :as core]
+                     [datadog     :refer [datadog]]
+                     [email       :refer [mailer]]
+                     [folds       :as folds]
+                     [graphite    :as graphite-client]
+                     [hipchat     :refer [hipchat]]
+                     [index       :as index]
+                     [influxdb    :refer [influxdb]]
+                     [kairosdb    :refer [kairosdb]]
+                     [keenio      :refer [keenio]]
+                     [librato     :refer [librato-metrics]]
+                     [logentries  :refer [logentries]]
+                     [logging     :as logging]
+                     [logstash    :as logstash-client]
+                     [mailgun     :refer [mailgun]]
+                     [nagios      :refer [nagios]]
+                     [opentsdb    :refer [opentsdb]]
+                     [opsgenie    :refer [opsgenie]]
+                     [pagerduty   :refer [pagerduty]]
+                     [plugin      :refer [load-plugin load-plugins]]
+                     [pubsub      :as pubsub]
+                     [pushover    :refer [pushover]]
+                     [repl]
+                     [service     :as service]
+                     [shinken     :refer [shinken]]
+                     [slack       :refer [slack]]
+                     [sns         :refer [sns-publisher]]
+                     [stackdriver :refer [stackdriver]]
+                     [streams     :refer :all]
+                     [test        :as test :refer [tap io tests]]
+                     [time        :refer [unix-time linear-time once! every!]]
+                     [twilio      :refer [twilio]]
+                     [xymon       :refer [xymon]]]
+            [riemann.transport [tcp        :as tcp]
+                               [udp        :as udp]
+                               [websockets :as websockets]
+                               [sse        :as sse]
+                               [graphite   :as graphite]
+                               [opentsdb   :as opentsdb]]
+            [cemerick.pomegranate :refer [add-dependencies]]
+            [clojure.java.io :refer [file]]
             [clojure.tools.nrepl.server :as repl]
-            [riemann.repl]
-            [riemann.index]
-            [riemann.test :as test :refer [tap io tests]])
-  (:use clojure.tools.logging
-        [clojure.java.io :only [file]]
-        [riemann.client :only [udp-client tcp-client multi-client]]
-        riemann.email
-        riemann.sns
-        [riemann.plugin  :only [load-plugin load-plugins]]
-        [riemann.time :only [unix-time linear-time once! every!]]
-        [riemann.pagerduty :only [pagerduty]]
-        [riemann.opsgenie :only [opsgenie]]
-        [riemann.keenio :only [keenio]]
-        [riemann.campfire :only [campfire]]
-        [riemann.kairosdb :only [kairosdb]]
-        [riemann.librato :only [librato-metrics]]
-        [riemann.logentries :only [logentries]]
-        [riemann.nagios :only [nagios]]
-        [riemann.opentsdb :only [opentsdb]]
-        [riemann.influxdb :only [influxdb]]
-        [riemann.hipchat :only [hipchat]]
-        [riemann.slack :only [slack]]
-        [riemann.stackdriver :only [stackdriver]]
-        [riemann.cloudwatch :only [cloudwatch]]
-        [riemann.datadog :only [datadog]]
-        [cemerick.pomegranate :only [add-dependencies]]
-        [riemann.shinken :only [shinken]]
-        [riemann.xymon :only [xymon]]
-        [riemann.mailgun :only [mailgun]]
-        [riemann.twilio :only [twilio]]
-        [riemann.boundary :only [boundary]]
-        [riemann.pushover :only [pushover]]
-        riemann.streams))
+            [clojure.tools.logging :refer :all]))

 (def core "The currently running core."
   (atom (core/core)))


make "private-a" the default subnet for aws-instance helper

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -98,7 +98,8 @@
     (resource "aws_instance" name (-> {:tags {:Name name}
                                        :instance_type "t2.micro"
                                        :key_name "ops-terraboot"
-                                       :monitoring true}
+                                       :monitoring true
+                                       :subnet_id (id-of "aws_subnet" "private-a")}
                                       (merge-in spec)
                                       (update-in [:vpc_security_group_ids] concat default-sg-ids)))))


make clojure 1.4 happy about board being dynamic

--- src/tile_game/core.clj
+++ src/tile_game/core.clj
@@ -26,7 +26,7 @@
                                      (int (+ cx (quot scale 2)))
                                      (int (+ cy (quot scale 2)))))))

-(def *board* (ref (create-board 2)))
+(def ^:dynamic *board* (ref (create-board 2)))

 (defn start-gui [dim]
   (let [size (* dim scale)


many changes, some on solver but mostly keyevents work

--- src/tile_game/core.clj
+++ src/tile_game/core.clj
@@ -1,9 +1,12 @@
 (ns tile-game.core
   (:require (clojure.contrib seq math))
   (:import (javax.swing JFrame JPanel )
-           (java.awt Color Graphics Graphics2D Dimension Font)))
+           (java.awt Color Graphics Graphics2D Dimension Font)
+           (java.awt.event KeyListener KeyEvent)))

-(def dim 3)
+(set! *warn-on-reflection* true)
+
+(def dim 5)
 (def scale 150)

 (def colors [Color/RED Color/ORANGE Color/YELLOW Color/GREEN
@@ -12,11 +15,17 @@
 (defn bounded-coords? [[x y]]
   (and (>= x 0) (< x dim) (>= y 0) (< y dim)))

+(defn manhattan [p1 p2]
+  (map #(clojure.contrib.math/abs (- %1 %2)) p1 p2))
+
+(defn distance [p1 p2]
+  (apply + (manhattan p1 p2)))
+
 (defn location [board [x y]]
   (nth board (+ (* x dim) y)))

 (defn position [board piece]
-  (.indexOf board piece))
+  (first (clojure.contrib.seq/positions #(= piece %) board)))

 (defn coords [board piece]
   (let [pos (position board piece)]
@@ -32,6 +41,14 @@
 (def dir-delta {:up [0 1] :down [0 -1]
                 :left [-1 0] :right [1 0]})

+(defn move-direction [board direction]
+  (let [[x y] (coords board 0)
+        [dx dy] (dir-delta direction)
+        coords [(+ x dx) (+ y dy)]]
+    (if (bounded-coords? coords)
+      (location board coords)
+      0)))
+
 (defn adjacent-coords [board [x y]]
   (let [adj-loc (map (fn [[dx dy]] [(+ x dx) (+ y dy)])
                      (vals dir-delta))]
@@ -42,10 +59,7 @@
        (adjacent-coords board (coords board piece))))

 (defn adjacent? [board p1 p2]
-  (let [[dx dy] (map #(Math/abs (- %1 %2))
-                     (coords board p1)
-                     (coords board p2))]
-    (= 1 (+ dx dy))))
+  (= 1 (distance (coords board p1) (coords board p2))))

 (defn can-move? [board piece]
   (adjacent? board 0 piece))
@@ -79,51 +93,74 @@

 (def solve (partial solver best-carlo '()))

-(defn run-solution [solution]
-  (doseq [next solution]
-    (render-move next)))
+;; (defn path-to
+;;   [board piece [goal-x goal-y :as goal]]
+;;   (let [[empty-x empty-y :as empty] (coords board 0)
+;;         [x y :as current] (coords board piece)]
+;;     (if (= current goal)
+;;       '()
+;;       (cons (path-to board ))))
+;;   [board goal]
+;;   ())

-;; (defn path-to
-;;   [board piece location]
-;;   (let [empty-pos (position board 0)
-;;         pos (position board piece)]
-;;     (if (= empty-pos pos)
-;;       '()
-;;       (path-to board location)))
-;;   [board location]
-;;   (cons ))
+(defn path-to [board goal]
+  (let [current (coords board 0)]
+    (if (= current goal)
+      ()
+      (let [next (first (sort-by #(distance goal (coords board %))
+                                 (legal-moves board)))]
+        (cons next (path-to (move board next) goal))))))

-(defn render [#^Graphics2D g]
-  (dorun
-   (for [x (range dim) y (range dim)]
-     (let [tile (location @*board* [x y])
-           color (if (= tile 0)
-             Color/WHITE
-             (colors (rem tile (count colors))))
-           [cx cy] [(* x scale) (* y scale)]]
+(defn render-tile [#^Graphics g board [x y]]
+  (let [tile (location board [x y])
+        color (if (= tile 0)
+                Color/WHITE
+                (colors (rem tile (count colors))))
+        [cx cy] [(* x scale) (* y scale)]]
        (doto g
          (.setColor color)
          (.fillRect cx cy scale scale)
-         (.setColor (if (= Color/BLACK color) Color/WHITE Color/BLACK))
-         (.setFont (Font. "Serif" (. Font PLAIN) 24))
-         (.drawString (.toString tile)
-                      (+ cx (quot scale 2))
-                      (+ cy (quot scale 2))
-                      ))))))
+         (.setColor Color/BLACK)
+         (.setFont (Font. "Serif" (. Font PLAIN) 32)))
+       (when (> tile 0) (.drawString g (format "%d" tile)
+                                     (+ cx (quot scale 2))
+                                     (+ cy (quot scale 2))))))

 (def *board* (ref (shuffle (vec (range 0 (* dim dim))))))

+(declare process-key)
 (def panel
-  (let [size (* dim scale)]
-    (doto (proxy [JPanel] []
-            (paint [g] (render g)))
-      (.setPreferredSize (Dimension. size size)))))
+  (let [size (* dim scale)
+        panel (proxy [JPanel KeyListener] []
+                (paint [g]
+                       (dorun (for [x (range dim) y (range dim)]
+                                (render-tile g @*board* [x y]))))
+                (keyPressed [#^KeyEvent e] (process-key (.getKeyCode e)))
+                (keyReleased [e]) ; do nothing
+                (keyTyped [e]) ; do nothing
+                )]
+    (doto panel
+      (.setPreferredSize (Dimension. size size))
+      (.setFocusable true)
+      (.addKeyListener panel))))

 (defn render-move [piece]
   (dosync (when (can-move? @*board* piece)
             (alter *board* move piece)))
-  (. panel (repaint)))
+  (. #^JPanel panel (repaint)))

-(def frame (doto (new JFrame) (.add panel) .pack .show))
+(defn process-key [code]
+  (let [dir-move (comp render-move (partial move-direction @*board*))]
+       (condp = code
+           KeyEvent/VK_LEFT  (dir-move :left)
+           KeyEvent/VK_RIGHT (dir-move :right)
+           KeyEvent/VK_UP    (dir-move :down)
+           KeyEvent/VK_DOWN  (dir-move :up)
+           KeyEvent/VK_Q     (.dispose #^JFrame frame))))

+(defn execute-moves [moves]
+  (doseq [m moves]
+    (render-move m)
+    (Thread/sleep 100)))

+(def frame (doto (new JFrame) (.add #^JPanel panel) .pack .show))


Start implementing changing values in the sudoku board

--- src/sudoku/core.cljs
+++ src/sudoku/core.cljs
@@ -1,29 +1,32 @@
 (ns sudoku.core
     (:require [reagent.core :as reagent]))

-(def board [[5 3 0 0 7 0 0 0 0]
-            [6 0 0 1 9 5 0 0 0]
-            [0 9 8 0 0 0 0 6 0]
-            [8 0 0 0 6 0 0 0 3]
-            [4 0 0 8 0 3 0 0 1]
-            [7 0 0 0 2 0 0 0 6]
-            [0 6 0 0 0 0 2 8 0]
-            [0 0 0 4 1 9 0 0 5]
-            [0 0 0 0 8 0 0 7 9]])
+(def board (reagent/atom [[5 3 0 0 7 0 0 0 0]
+                          [6 0 0 1 9 5 0 0 0]
+                          [0 9 8 0 0 0 0 6 0]
+                          [8 0 0 0 6 0 0 0 3]
+                          [4 0 0 8 0 3 0 0 1]
+                          [7 0 0 0 2 0 0 0 6]
+                          [0 6 0 0 0 0 2 8 0]
+                          [0 0 0 4 1 9 0 0 5]
+                          [0 0 0 0 8 0 0 7 9]]))

 (defn value-at [board coord]
   (get-in board coord))
+
+(defn set-value-at [board coord new-value]
+  (assoc-in board coord new-value))
 ;; -------------------------
 ;; Components
 (defn cell [coords]
-  (let [value (value-at board coords)]
-    [:td {:on-click #(js/console.log (first coords) (second coords))}
-      (when (not (zero? value)) value)]))
+  (let [value (reagent/atom (value-at @board coords))]
+    [:td {:on-click #(swap! board set-value-at coords (inc @value))}
+       (when (not (zero? @value)) @value)]))

 (defn sudoku-board []
-  [:table (for [row (range 0 10)]
-            [:tr (for [column (range 0 10)]
-                   [cell [row column]])])])
+  [:table [:tbody (for [row (range 0 9)]
+            [:tr (for [column (range 0 9)]
+                   [cell [row column]])])]])

 ;; -------------------------
 ;; Views


Compojure: Clamp query count between 1 and 500 to comply with test spec

--- compojure/hello/src/hello/handler.clj
+++ compojure/hello/src/hello/handler.clj
@@ -82,12 +82,22 @@
      queries ; Number of queries to run
      (repeatedly get-world-raw)))))

+(defn get-query-count [queries]
+  "Parse provided string value of query count, clamping values to between 1 and 500."
+  (let [q (try (Integer/parseInt queries)
+               (catch Exception e 1))] ; default to 1 on parse failure
+    (if (> q 500)
+      500 ; clamp to 500 max
+      (if (< q 1)
+        1 ; clamp to 1 min
+        q)))) ; otherwise use provided value
+
 ; Define route handlers
 (defroutes app-routes
   (GET "/" [] "Hello, World!")
   (GET "/json" [] (response {:message "Hello, World!"}))
-  (GET "/db/:queries" [queries] (response (run-queries (Integer/parseInt queries))))
-  (GET "/dbraw/:queries" [queries] (response (run-queries-raw (Integer/parseInt queries))))
+  (GET "/db/:queries" [queries] (response (run-queries (get-query-count queries))))
+  (GET "/dbraw/:queries" [queries] (response (run-queries-raw (get-query-count queries))))
   (route/not-found "Not Found"))

 ; Format responses as JSON


Fix issue from Eastwood. Thanks Eastwood!

--- src/oc/storage/api/activity.clj
+++ src/oc/storage/api/activity.clj
@@ -29,8 +29,9 @@
     (* order-flip (compare (or (:published-at x) (:created-at x))
                            (or (:published-at y) (:created-at y))))))

-(defn- merge-activity [entries stories order]
+(defn- merge-activity
   "Given a set of entries and stories and a sort order, return up to the default limit of them, intermixed and sorted."
+  [entries stories order]
   (take config/default-limit (sort (partial activity-sort order) (concat entries stories))))

 (defn- assemble-activity


Debug mapbox in prod

Debug mapbox in prod

--- src/pasmo_gigi/geo/ui/core.cljs
+++ src/pasmo_gigi/geo/ui/core.cljs
@@ -10,6 +10,8 @@
             [pasmo-gigi.geo.ui.routes :as routes]
             [mapbox.L :as L])
   (:require-macros [cljs.core.async.macros :refer [go]]))
+
+(.console.log "access token: " (-> js/L .-mapbox .-accessToken))

 (set! (-> js/L .-mapbox .-accessToken) "pk.eyJ1IjoidXJpczc3IiwiYSI6InRuYTZRa3MifQ._Bo-JRcA7QVGocCJvdSoJg")


Fix lib.auth/ids fun

Fix lib.auth/ids fun

--- backend/src/akvo/lumen/lib/auth.clj
+++ backend/src/akvo/lumen/lib/auth.clj
@@ -137,6 +137,7 @@

 (defn ids [spec data]
   (let [ids (atom {:dataset-ids #{}
+                   :dashboard-ids #{}
                    :visualisation-ids #{}})
         original-vis-id? visualisation.s/*id?*
         original-ds-id? dataset.s/*id?*


upgrade clj-http and cloudfoundry-client-lib in order to support TLS 1.1,1.2

Signed-off-by: Chris Hedley <711c73f64afdce07b7e38039a96d2224209e9a6c@cghsystems.net>

--- src/rabbitmq-broker/project.clj
+++ src/rabbitmq-broker/project.clj
@@ -2,12 +2,17 @@
   :description "Pivotal CF RabbitMQ service broker"
   :dependencies [[org.clojure/clojure     "1.6.0"]
                  ;; CF client
-                 [clojurewerkz/mold       "1.0.0-beta4"]
+                 [clojurewerkz/mold       "1.0.0-beta4" :exclusions [org.cloudfoundry/cloudfoundry-client-lib]]
+
+                 ;; org.cloudfoundry/cloudfoundry-client-lib - used by clojurewerks/mold
+                 ;; need to update to work with jac
+                 [org.cloudfoundry/cloudfoundry-client-lib "1.1.0"]
+
                  ;; RabbitMQ client (including HTTP API)
                  [com.novemberain/langohr "3.0.0-rc4" :exclusions [clj-http]]
                  ;; HTTP client which uses HTTPCore 4.2.x, compatible
                  ;; with Spring 3 and CF Java client.
-                 [clj-http                "0.7.6"]
+                 [clj-http                "1.0.1"]
                  ;; routing, etc for HTTP API
                  [compojure                 "1.2.0"     :exclusions [org.clojure/clojure ring/ring-core]]
                  [ring/ring-core            "1.3.1"]


Change font buffer lifetime to match font info lifetime to fix seg fault

--- src/zaffre/font.cljc
+++ src/zaffre/font.cljc
@@ -30,11 +30,6 @@
 ;  (fn [_ _ _ calls]
 ;    (spit "calls.log" calls)))

-(defn log-call [method-name & args]
-  (spit "calls.log" {:method-name method-name :args args} :append true)
-  (spit "calls.log" "\n" :append true)
-  (swap! calls (fn [calls] (conj calls {:method-name method-name :args args}))))
-
 (defn- byte-buffer->str [^ByteBuffer buffer]
   (if buffer
     (loop [s ""]
@@ -92,6 +87,7 @@
             (.toPath file)))))))

 (declare make-font)
+(declare font-data)

 (def system-fonts-map
   (delay
@@ -101,7 +97,7 @@
               (try
                 #_(log/info "type path" (type path))
                 (let [file        (.toFile path)
-                      font-info   (make-font file)
+                      font-info   (make-font (font-data file))
                       font-name   (font-name font-info)
                       font-family (font-family font-info)]
                   [[font-name file]
@@ -124,7 +120,8 @@
               file
               (get (system-fonts) x)))))))

-(defn make-font
+
+(defn font-data
   [x]
   (if-let [font-path (as-font-path x)]
     ;; Load font from file
@@ -136,11 +133,15 @@
          direct-buffer (BufferUtils/createByteBuffer (.limit buffer))]
       (doto direct-buffer
         (.put buffer)
-        (.flip))
-      (if (zero? (STBTruetype/stbtt_InitFont info direct-buffer))
-        (throw (RuntimeException. (str "Error loading font " x)))
-        info))
+        (.flip)))
     (throw (RuntimeException. (str "Font " x " does not exist")))))
+
+(defn make-font
+  [font-data]
+  (let [info (STBTTFontinfo/calloc)]
+    (if (zero? (STBTruetype/stbtt_InitFont info font-data))
+      (throw (RuntimeException. "Error loading font"))
+      info)))

 (def cjk-blocks
   (set
@@ -155,7 +156,6 @@
   "Returns a map from codepoint to glyph index"
   (into {}
     (reduce (fn [m codepoint]
-             (log-call "STBTruetype/stbtt_FindGlyphIndex" font (int codepoint))
              (let [glyph-index (STBTruetype/stbtt_FindGlyphIndex font (int codepoint))]
                (if  (and (pos? glyph-index)
                          (not (contains? cjk-blocks codepoint)))
@@ -239,7 +239,6 @@
 (defn-ms hmetrics [^MemoryStack ms ^STBTTFontinfo font-info glyph-index]
   (let [advance-width     (.mallocInt ms 1)
         left-side-bearing (.mallocInt ms 1)]
-    (log-call "STBTruetype/stbtt_GetGlyphHMetrics" font-info (int glyph-index) advance-width left-side-bearing)
     (STBTruetype/stbtt_GetGlyphHMetrics font-info (int glyph-index) advance-width left-side-bearing)
     [(.get advance-width) (.get left-side-bearing)]))

@@ -247,7 +246,6 @@
   (let [ascent   (.mallocInt ms 1)
         descent  (.mallocInt ms 1)
         line-gap (.mallocInt ms 1)]
-    (log-call "STBTruetype/stbtt_GetFontVMetrics" font-info ascent descent line-gap)
     (STBTruetype/stbtt_GetFontVMetrics font-info ascent descent line-gap)
     [(.get ascent) (.get descent) (.get line-gap)]))

@@ -256,15 +254,6 @@
         iy0 (.mallocInt ms 1)
         ix1 (.mallocInt ms 1)
         iy1 (.mallocInt ms 1)]
-    (log-call "STBTruetype/stbtt_GetGlyphBitmapBox"
-      font-info
-      (int glyph-index)
-      (float scale)
-      (float scale)
-      ix0
-      iy0
-      ix1
-      iy1)
     (STBTruetype/stbtt_GetGlyphBitmapBox
       font-info
       (int glyph-index)
@@ -290,17 +279,6 @@
     ;        "left-side-bearing" left-side-bearing "y" y)
     ;(log/info "x0" x0 "y0" y0 "x1" x1 "y1" y1)
     ;; draw greyscale font
-    (log-call "STBTruetype/stbtt_MakeGlyphBitmapSubpixel"
-      font-info
-      (get img :byte-buffer)
-      char-width
-      char-height
-      char-width
-      scale
-      scale
-      0.0
-      0.0
-      (int glyph-index))
     (STBTruetype/stbtt_MakeGlyphBitmapSubpixel
       font-info
       (get img :byte-buffer)
@@ -316,7 +294,8 @@
     ;(zimg/write-png chr-img (str "char-image/" (int codepoint) ".png"))
     ;(zimg/write-png img (str "char-image/" (int codepoint) "-raw.png"))
     ;; convert to rgba
-    (zimg/mode chr-img :rgba)))
+    (zimg/mode chr-img :rgba)
+    #_(zimg/image char-width char-height 4)))

 (defn glyph-graphics? [m]
   (every?
@@ -373,7 +352,8 @@
   (glyph-graphics [this]
     ;; Adjust canvas to fit character atlas size
     (let [ms (MemoryStack/create)
-          ^STBTTFontinfo font-info   (make-font name-or-path)
+          font-data                  (font-data name-or-path)
+          ^STBTTFontinfo font-info   (make-font font-data)
           scale                      (STBTruetype/stbtt_ScaleForPixelHeight
                                        font-info
                                        size)


:lipstick: Minor cosmetic changes.

:lipstick: Minor cosmetic changes.

--- frontend/src/uxbox/main/ui/workspace/viewport.cljs
+++ frontend/src/uxbox/main/ui/workspace/viewport.cljs
@@ -256,7 +256,8 @@
                 key3 (events/listen dnode EventType.MOUSEMOVE on-mouse-move)
                 ;; bind with passive=false to allow the event to be cancelled
                 ;; https://stackoverflow.com/a/57582286/3219895
-                key4 (events/listen js/window EventType.WHEEL on-mouse-wheel #js {"passive" false})]
+                key4 (events/listen js/window EventType.WHEEL on-mouse-wheel
+                                    #js {"passive" false})]
             (fn []
               (events/unlistenByKey key1)
               (events/unlistenByKey key2)


Adding Marginalia. (Doesn't work yet.)

Adding Marginalia. (Doesn't work yet.)

--- examples/basic/project.clj
+++ examples/basic/project.clj
@@ -3,5 +3,5 @@
   :dependencies [[org.clojure/clojure "[1.1.0,1.2.0]"]
                  [org.clojure/clojure-contrib "[1.1.0,1.2.0]"]
 		 [midje "1.1-alpha-1"]]
-)
+  :dev-dependencies [[marginalia "0.3.2"]])


Update cider version

Update cider version

--- lein/.lein/profiles.clj
+++ lein/.lein/profiles.clj
@@ -1,5 +1,5 @@
 {:user {
-        :plugins [[cider/cider-nrepl "0.11.0-SNAPSHOT"]
+        :plugins [[cider/cider-nrepl "0.12.0-SNAPSHOT"]
                   [jonase/eastwood "0.2.3"]
                   [lein-kibit "0.1.2"]
                   [lein-typed "0.3.5"]


Extract lookup struct-generating code

Extract lookup struct-generating code

--- modules/reitit-core/src/reitit/core.cljc
+++ modules/reitit-core/src/reitit/core.cljc
@@ -165,6 +165,23 @@
    :compile (fn [[_ {:keys [handler]}] _] handler)
    :conflicts (partial throw-on-conflicts! path-conflicts-str)})

+(defn- linear-router-lookup-structs
+  "Returns a 2-item vec of lookup structures.
+
+  The first is a vec of Routes.
+  The second is a map of route names to lookup fns."
+  [compiled-routes]
+  (reduce
+    (fn [[pl nl] [p {:keys [name] :as data} result]]
+      (let [{:keys [path-params] :as route} (impl/create [p data result])
+            f #(if-let [path (impl/path-for route %)]
+                 (->Match p data result % path)
+                 (->PartialMatch p data result % path-params))]
+        [(conj pl route)
+         (if name (assoc nl name f) nl)]))
+    [[] {}]
+    compiled-routes))
+
 (defn linear-router
   "Creates a linear-router from resolved routes and optional
   expanded options. See [[router]] for available options"
@@ -172,15 +189,7 @@
    (linear-router compiled-routes {}))
   ([compiled-routes opts]
    (let [names (find-names compiled-routes opts)
-         [pl nl] (reduce
-                   (fn [[pl nl] [p {:keys [name] :as data} result]]
-                     (let [{:keys [path-params] :as route} (impl/create [p data result])
-                           f #(if-let [path (impl/path-for route %)]
-                                (->Match p data result % path)
-                                (->PartialMatch p data result % path-params))]
-                       [(conj pl route)
-                        (if name (assoc nl name f) nl)]))
-                   [[] {}] compiled-routes)
+         [pl nl] (linear-router-lookup-structs compiled-routes)
          lookup (impl/fast-map nl)
          routes (uncompile-routes compiled-routes)]
      ^{:type ::router}
@@ -209,6 +218,21 @@
          (if-let [match (impl/fast-get lookup name)]
            (match (impl/path-params path-params))))))))

+(defn- lookup-router-lookup-structs
+  "Returns a 2-item vec of lookup structures.
+
+  The first is a map of paths to Matches.
+  The second is a map of route names to Matches."
+  [compiled-routes]
+  (reduce
+    (fn [[pl nl] [p {:keys [name] :as data} result]]
+      [(assoc pl p (->Match p data result {} p))
+       (if name
+         (assoc nl name #(->Match p data result % p))
+         nl)])
+    [{} {}]
+    compiled-routes))
+
 (defn lookup-router
   "Creates a lookup-router from resolved routes and optional
   expanded options. See [[router]] for available options"
@@ -222,12 +246,7 @@
          {:wilds wilds
           :routes compiled-routes})))
    (let [names (find-names compiled-routes opts)
-         [pl nl] (reduce
-                   (fn [[pl nl] [p {:keys [name] :as data} result]]
-                     [(assoc pl p (->Match p data result {} p))
-                      (if name
-                        (assoc nl name #(->Match p data result % p))
-                        nl)]) [{} {}] compiled-routes)
+         [pl nl] (lookup-router-lookup-structs compiled-routes)
          data (impl/fast-map pl)
          lookup (impl/fast-map nl)
          routes (uncompile-routes compiled-routes)]
@@ -252,6 +271,23 @@
          (if-let [match (impl/fast-get lookup name)]
            (match (impl/path-params path-params))))))))

+(defn- segment-router-lookup-structs
+  "Returns a 2-item vec of lookup structures.
+
+  The first is a prefix-tree of segments and associated Matches.
+  The second is a map of route names to Matches or PartialMatches."
+  [compiled-routes]
+  (reduce
+    (fn [[pl nl] [p {:keys [name] :as data} result]]
+      (let [{:keys [path-params] :as route} (impl/create [p data result])
+            f #(if-let [path (impl/path-for route %)]
+                 (->Match p data result % path)
+                 (->PartialMatch p data result % path-params))]
+        [(segment/insert pl p (->Match p data result nil nil))
+         (if name (assoc nl name f) nl)]))
+    [nil {}]
+    compiled-routes))
+
 (defn segment-router
   "Creates a special prefix-tree style segment router from resolved routes and optional
   expanded options. See [[router]] for available options"
@@ -259,15 +295,7 @@
    (segment-router compiled-routes {}))
   ([compiled-routes opts]
    (let [names (find-names compiled-routes opts)
-         [pl nl] (reduce
-                   (fn [[pl nl] [p {:keys [name] :as data} result]]
-                     (let [{:keys [path-params] :as route} (impl/create [p data result])
-                           f #(if-let [path (impl/path-for route %)]
-                                (->Match p data result % path)
-                                (->PartialMatch p data result % path-params))]
-                       [(segment/insert pl p (->Match p data result nil nil))
-                        (if name (assoc nl name f) nl)]))
-                   [nil {}] compiled-routes)
+         [pl nl] (segment-router-lookup-structs compiled-routes)
          lookup (impl/fast-map nl)
          routes (uncompile-routes compiled-routes)]
      ^{:type ::router}


chore: fix kibit warning

chore: fix kibit warning

https://github.com/chrovis/cljam/runs/4615409310?check_suite_focus=true

--- src/cljam/io/vcf/reader.clj
+++ src/cljam/io/vcf/reader.clj
@@ -61,7 +61,7 @@
 (defn- dot->nil
   [^String s]
   ;; Avoid calling equiv on strings.
-  (if (and (= 1 (.length s)) (= \. (.charAt s 0))) nil s))
+  (when-not (and (= 1 (.length s)) (= \. (.charAt s 0))) s))

 ;; Loading meta-information
 ;; ------------------------


Expose hook for user to provide additional data for context (e.g. app root node, etc.)

--- src/cljs/dato/lib/core.cljs
+++ src/cljs/dato/lib/core.cljs
@@ -299,14 +299,16 @@
 (defn ss [dato]
   @(:ss dato))

-(defn start-loop! [dato]
+(defn start-loop! [dato additional-context]
   (let [dato-ch (get-in dato [:comms :dato])
         conn    (get-in dato [:conn])
         ;; TODO: This is messy, clean up once api and ss are merged
         ;; concepts
         api     (get-in dato [:api])
         ss      (get-in dato [:ss])
-        context (merge api {:ss ss} {:dato dato})]
+        ;; User's additional-context isn't able to override the
+        ;; dato-provided context, to prevent confusion
+        context (merge additional-context api {:ss ss} {:dato dato})]
     (go
       (loop []
         (alt!


change urls for yeast (to live) and worm (to a version with orthologues)

--- src/cljs/gointermod/db.cljs
+++ src/cljs/gointermod/db.cljs
@@ -80,13 +80,13 @@
     :worm
      {:id     :worm
       :common "Worm"
-      :output? false
+      :output? true
       :abbrev "C. elegans"
       :status {:status :na}
       :mine
        {:name "WormMine"
-        :url "intermine.wormbase.org/tools/wormmine"
-        :service {:root "intermine.wormbase.org/tools/wormmine"}}}
+        :url "im-251.wormbase.org/tools/wormmine"
+        :service {:root "im-251.wormbase.org/tools/wormmine"}}}
     :yeast
      {:id     :yeast
       :output? true
@@ -95,10 +95,10 @@
       :status {:status :na}
       :mine
        {:name "YeastMine"
-;       :url "yeastmine.yeastgenome.org/yeastmine"
-;       :service {:root "yeastmine.yeastgenome.org/yeastmine"}}}
-       :url "yeastmine-test.yeastgenome.org/yeastmine-dev"
-       :service {:root "yeastmine-test.yeastgenome.org/yeastmine-dev"}}}
+       :url "yeastmine.yeastgenome.org/yeastmine"
+       :service {:root "yeastmine.yeastgenome.org/yeastmine"}}}
+;       :url "yeastmine-test.yeastgenome.org/yeastmine-dev"
+;       :service {:root "yeastmine-test.yeastgenome.org/yeastmine-dev"}}}
     }
    :go-ontology {:nodes 0
                  :loading true}


fixed bug for localhost installation

fixed bug for localhost installation

--- main/src/dda/pallet/dda_managed_ide/infra/atom.clj
+++ main/src/dda/pallet/dda_managed_ide/infra/atom.clj
@@ -18,6 +18,7 @@
   (:require
     [schema.core :as s]
     [clojure.tools.logging :as logging]
+    [pallet.action :as action]
     [pallet.actions :as actions]
     [dda.config.commons.map-utils :as map-utils]))

@@ -44,6 +45,7 @@
     (when (contains? atom-config :plugins)
       (let [plugins (-> atom-config :plugins)]
         (doseq [plugin plugins]
-          (actions/exec-checked-script
-            (str "install-apm-plugin-" plugin)
-            ("apm install" ~plugin)))))))
+          (action/with-action-options {:script-prefix :sudo}
+            (actions/exec-checked-script
+              (str "install-apm-plugin-" plugin)
+              ("apm install" ~plugin))))))))


Add JDK 19 & exclude openjdk:18-alpine variants

--- src/docker_clojure/core.clj
+++ src/docker_clojure/core.clj
@@ -33,7 +33,7 @@

 (def base-image "openjdk")

-(def jdk-versions #{8 11 17 18})
+(def jdk-versions #{8 11 17 18 19})

 ;; The default JDK version to use for tags that don't specify one; usually the latest LTS release
 (def default-jdk-version 17)
@@ -72,6 +72,8 @@
     {:jdk-version 11
      :distro      :alpine/alpine}
     {:jdk-version 17
+     :distro      :alpine/alpine}
+    {:jdk-version 18
      :distro      :alpine/alpine}})

 (def maintainers