Adding graphics password

Adding graphics password

--- apoya-app/src/clj/apoya/core.clj
+++ apoya-app/src/clj/apoya/core.clj
@@ -10,7 +10,9 @@
             [fortress.util :as util]
             [compojure.route :as route]
             [nomad :refer [defconfig]])
-  (:import [ch.qos.logback.classic.joran JoranConfigurator]
+  (:import [java.awt GraphicsEnvironment]
+           [javax.swing JPasswordField JOptionPane]
+           [ch.qos.logback.classic.joran JoranConfigurator]
            [ch.qos.logback.core.util StatusPrinter]
            [org.slf4j LoggerFactory])
   (:gen-class))
@@ -31,6 +33,13 @@

 (defn read-password []
   (cond
+    (not (GraphicsEnvironment/isHeadless)) (let [pf (JPasswordField.)
+                                                 result (JOptionPane/showConfirmDialog nil pf
+                                                                                "Fortress: Enter certificate password"
+                                                                                JOptionPane/OK_CANCEL_OPTION
+                                                                                JOptionPane/PLAIN_MESSAGE)]
+                                             (if (= result JOptionPane/OK_OPTION)
+                                               (.getPassword pf)))
     (not (nil? (System/console))) (.readPassword (System/console) "Private key password: " (object-array 0))))

 (defn build-ssl-context [key-file crt-file]


update example

update example

--- example/counter/core.cljs
+++ example/counter/core.cljs
@@ -1,6 +1,7 @@
 (ns counter.core
   (:require [rum.core :as rum]
-            [scrum.core :as scrum]))
+            [scrum.core :as scrum]
+            [goog.dom :as dom]))

 ;;
 ;; define controller & action handlers
@@ -11,13 +12,34 @@
 (defmulti control (fn [action] action))

 (defmethod control :init []
-  initial-state)
+  {:state initial-state})
+
+(defmethod control :load [_ [key]]
+  {:local-storage {:op :get
+                   :key key
+                   :on-success :load-ready}})
+
+(defmethod control :load-ready [_ [counter]]
+  {:state (int counter)})
+
+(defmethod control :save [_ [key] counter]
+  {:local-storage {:op :set
+                   :value counter
+                   :key key}})

 (defmethod control :inc [_ _ counter]
-  (inc counter))
+  (let [next-counter (inc counter)]
+    {:state next-counter
+     :local-storage {:op :set
+                     :value next-counter
+                     :key :count}}))

 (defmethod control :dec [_ _ counter]
-  (dec counter))
+  (let [next-counter (dec counter)]
+    {:state next-counter
+     :local-storage {:op :set
+                     :value next-counter
+                     :key :count}}))

 ;;
@@ -32,17 +54,37 @@

 ;;
+;; define effects handler
+;;
+
+(defn local-storage [r c {:keys [op key value on-success]}]
+  (case op
+    :get
+    (->> (name key)
+         js/localStorage.getItem
+         (scrum/dispatch! r c on-success))
+    :set
+    (-> (name key)
+        (js/localStorage.setItem value))))
+
+
+;;
 ;; start up
 ;;

 ;; create Reconciler instance
 (defonce reconciler
-  (scrum/reconciler {:state (atom {})
-                     :controllers {:counter control}}))
+  (scrum/reconciler
+    {:state (atom {})
+     :controllers {:counter control}
+     :effect-handlers {:local-storage local-storage}}))

 ;; initialize controllers
 (defonce init-ctrl (scrum/broadcast-sync! reconciler :init))

+;; load from localStorage
+(defonce load (scrum/dispatch-sync! reconciler :counter :load :count))
+
 ;; render
 (rum/mount (Counter reconciler)
-           (. js/document (getElementById "app")))
+           (dom/getElement "app"))


minor cleanup

minor cleanup

--- src-cljs/jasons_game/ui.cljs
+++ src-cljs/jasons_game/ui.cljs
@@ -8,8 +8,8 @@
 ;; Styles

 (def styles {:cursor {:stroke 0}
-             :person {:stroke 0, :fill [255, 0, 0]}
-             :speech-balloon {:fill [0, 0, 255]}
+             :person {:stroke 0, :fill [0 255 0]}
+             :speech-balloon {:fill [0 0 255]}
              :words {:fill 255}})

 (defn to-processing-color
@@ -121,8 +121,7 @@
                         (s/background 100)

                         (draw-person mx my)
-                        (let [img (s/load-image "logo-color-255x75.png")]
-                          (s/image img 100 100))
+                        (s/image (s/load-image "logo-color-255x75.png") 100 100)
                         (draw-cursor mx my)

                         (show-coords mx my)))})


Maintenance: Fixed test that was failing non-deterministically.

--- system-int-test/test/cmr/system_int_test/ingest/bulk_update/bulk_update_flow_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/bulk_update/bulk_update_flow_test.clj
@@ -57,15 +57,15 @@
         (are3 [accept-format]
           (let [response (ingest/bulk-update-provider-status "PROV1"
                           {:accept-format accept-format})]
-            (is (= [{:task-id task-id-1,
-                     :status-message "All collection updates completed successfully.",
-                     :status "COMPLETE",
-                     :request-json-body json-body}
-                    {:task-id task-id-2,
-                     :status-message "All collection updates completed successfully.",
-                     :status "COMPLETE",
-                     :request-json-body json-body}]
-                   (:tasks response))))
+            (is (= (set [{:task-id task-id-1,
+                          :status-message "All collection updates completed successfully.",
+                          :status "COMPLETE",
+                          :request-json-body json-body}
+                         {:task-id task-id-2,
+                          :status-message "All collection updates completed successfully.",
+                          :status "COMPLETE",
+                          :request-json-body json-body}])
+                   (set (:tasks response)))))
           "JSON" :json
           "XML" :xml))


Fix test line length

Fix test line length

--- test/compojure/response_test.clj
+++ test/compojure/response_test.clj
@@ -62,5 +62,5 @@

   (testing "with vector"
     (is (thrown-with-msg? IllegalArgumentException
-                          #"No implementation of method: :render of protocol: #'compojure.response/Renderable"
+                          #"No implementation of method: :render of protocol"
                           (response/render [] {})))))


Fix unitest

Fix unitest

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>

--- test/emulator_4917/core_test.clj
+++ test/emulator_4917/core_test.clj
@@ -48,12 +48,12 @@
           cpu (make-cpu :r0 r0 :r1 r1)]
       ;; the result should the same
       ;; TODO: more accurate mock method
-      (is (= cpu (cmd7 cpu)))))
+      (is (= 7 (:is (cmd7 cpu))))))

   ;; FIXME: how to mock println correctly ?
   (testing "cmd 8: Print <data>"
     (let [cpu (make-cpu :memory [8 5 0])]
-      (is (= cpu (cmd8 cpu)))))
+      (is (= 8 (:is (cmd8 cpu))))))

   (testing "cmd 9: Load value from <data> to R0"
     (let [cpu (make-cpu :memory [9 0 0])]
@@ -65,11 +65,11 @@

   (testing "cmd 11: Store R0 into <data> position"
     (let [cpu (make-cpu :memory [11 2 0] :r0 5)]
-      (is (= [11 2 5] (:memory (cmd11 cpu))))))
+      (is (= [11 2 5] (take 3 (:memory (cmd11 cpu)))))))

   (testing "cmd 12: Store R1 into <data> position"
     (let [cpu (make-cpu :memory [12 2 0] :r1 5)]
-      (is (= [12 2 5] (:memory (cmd12 cpu))))))
+      (is (= [12 2 5] (take 3 (:memory (cmd12 cpu)))))))

   (testing "cmd 13: jump to address <data>"
     (let [cpu (make-cpu :memory [13 2 0])]


CMR-1694: A minor refactoring of the code.

--- ingest-app/src/cmr/ingest/api/routes.clj
+++ ingest-app/src/cmr/ingest/api/routes.clj
@@ -127,20 +127,24 @@
      :headers {"Content-Type" (mt/format->mime-type :xml)}
      :body (result-map->xml result)})

+(defn- invalid-revision-id-error
+  "Throw an error saying that revision is invalid"
+  [revision-id]
+  (srvc-errors/throw-service-error
+    :bad-request
+    (msg/invalid-revision-id revision-id)))
+
 (defn- set-revision-id
   "Associate revision id to concept if revision id is a positive integer. Otherwise return an error"
   [concept headers]
   (if-let [revision-id (get headers "revision-id")]
-    (let [throw-error (partial srvc-errors/throw-service-error
-                               :bad-request
-                               (msg/invalid-revision-id revision-id))]
-      (try
-        (let [revision-id (Integer/parseInt revision-id)]
-          (if (pos? revision-id)
-            (assoc concept :revision-id revision-id)
-            (throw-error)))
-        (catch NumberFormatException _
-          (throw-error))))
+    (try
+      (let [revision-id (Integer/parseInt revision-id)]
+        (if (pos? revision-id)
+          (assoc concept :revision-id revision-id)
+          (invalid-revision-id-error revision-id)))
+      (catch NumberFormatException _
+        (invalid-revision-id-error revision-id)))
     concept))

 (defn- set-concept-id


Fix lookup of peer id when restarting vpeer

--- src/onyx/state/log/bookkeeper.clj
+++ src/onyx/state/log/bookkeeper.clj
@@ -126,7 +126,7 @@
                                                :prev-ledger-ids (vec (butlast current-ids))
                                                :new-ledger-ids [compacted-ledger-id]}}))
                                 (fn []
-                                  (>!! (:onyx.core/group-ch event) [:restart-vpeer (:id event)])))))))))
+                                  (>!! (:onyx.core/group-ch event) [:restart-vpeer (:onyx.core/id event)])))))))))

 (defn assign-bookkeeper-log-id-spin [{:keys [onyx.core/peer-opts
                                              onyx.core/job-id onyx.core/task-id
@@ -258,4 +258,4 @@
                   HandleWriteCallback
                   (list ack-fn
                         (fn []
-                          (>!! (:onyx.core/group-ch event) [:restart-vpeer (:id event)])))))
+                          (>!! (:onyx.core/group-ch event) [:restart-vpeer (:onyx.core/id event)])))))


Ready-coloring to strategy-list items

Ready-coloring to strategy-list items

--- src/glory_of_empires/players.clj
+++ src/glory_of_empires/players.clj
@@ -36,22 +36,28 @@

 (defn- player-flag [ race-id ] [ :img {:src (str html/resources-url "FlagWavy/Flag-Wavy-" (name race-id) ".png")} ] )

+(defn ready-color [ready content]
+  (html/color-span (if ready "#00ff00" "#808080") content))
+
 (defn- player-controls [race-id]
   (fn [ { controller :controller owner :owner } ]
     (or (= controller race-id) (= owner race-id) )))

 (defn filter-player [ race-id items ] (filter (player-controls race-id) items))

+(defn strategy-list-item [ { id :id ready :ready } ]
+  [ :div (ready-color ready (str/capitalize (name id)))]   )
+
 (defn- player-row-data [ board planets
                         { race-id :id tg :tg ac :ac pc :pc cc :command-pool sa :strategy-alloc fs :fleet-supply
                          strategies :strategies } ]
   (let [ player-systems (filter-player race-id board)
         player-planets (filter-player race-id planets) ]
-    [(apply min (map :order strategies))
-     (->> strategies (map :id) (map (fn [s] [ :div s ] )))
-     (str/capitalize (name race-id))
+    [(str/capitalize (name race-id))
      (fighter-image race-id)
      (player-flag race-id)
+     (apply min (map :order strategies))
+     (map strategy-list-item strategies)
      "VP"
      cc
      fs
@@ -67,7 +73,7 @@
      (count pc)   ]))

 (defn players-table [ amended-players board amended-planets ]
-  (let [ header [ "Init" "Strategy" "Race" "Color" "Symbol" "VP" "CC" "FS" "SA" "Systems" "Planets" "Res" "Inf" "TG" "Army Res" "Tech" "AC" "PC" ]
+  (let [ header [ "Race" "Color" "Symbol" "Init" "Strategy"  "VP" "CC" "FS" "SA" "Systems" "Planets" "Res" "Inf" "TG" "Army Res" "Tech" "AC" "PC" ]
         rows (map #(player-row-data board amended-planets %) amended-players) ]
     (html/table { :class "data" } (concat (list header) rows) )))

@@ -79,7 +85,7 @@
 (defn- planet-to-html [ { id :id fresh :fresh res :res inf :inf } ]
   (list (str/capitalize (name id)) " - " (html/color-span "green" res)
         " + " (html/color-span "#ff4040" inf) " - "
-        (if fresh (html/color-span "#00ff00" "Ready") (html/color-span "#808080" "Exhausted")))  )
+        (ready-color fresh (if fresh "Ready" "Exhausted"))   ))

 (defn- player-html [ role all-planets { race-id :id acs :ac } ]
   { :pre [ (not (nil? race-id)) ] }


Adds fixme - example needs update.

Adds fixme - example needs update.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -909,6 +909,7 @@
   throws `IllegalArgumentException` if no `<clause>` matches and no
   `<alternative>` is given.

+  FIXME: Example with-bindings / without-bindings.
   Example:

         (def example-map-matcher


reduce doc width

reduce doc width

--- src/overtone/sc/ugen/defaults.clj
+++ src/overtone/sc/ugen/defaults.clj
@@ -34,5 +34,5 @@
    "in" "the input signal"
    })

-(def DOC-WIDTH 60)
+(def DOC-WIDTH 45)


🏗 Triggering db-admin, handling transient events

--- src/territory_bro/projections.clj
+++ src/territory_bro/projections.clj
@@ -7,11 +7,23 @@
             [mount.core :as mount]
             [territory-bro.congregation :as congregation]
             [territory-bro.db :as db]
+            [territory-bro.db-admin :as db-admin]
             [territory-bro.event-store :as event-store]
             [territory-bro.gis-user :as gis-user]
             [territory-bro.poller :as poller])
   (:import (com.google.common.util.concurrent ThreadFactoryBuilder)
            (java.util.concurrent Executors ScheduledExecutorService TimeUnit)))
+
+(mount/defstate *transient-events
+  :start (atom []))
+
+(defn read-transient-events! []
+  (let [[new-events _] (reset-vals! *transient-events [])]
+    new-events))
+
+(defn dispatch-transient-event! [event]
+  (assert (:event/transient? event) {:event event})
+  (swap! *transient-events conj event))

 (mount/defstate *cache
   :start (atom {:last-event nil
@@ -20,24 +32,33 @@
 (defn- update-projections [state event]
   (-> state
       (congregation/congregations-view event)
-      (gis-user/gis-users-view event)))
+      (gis-user/gis-users-view event)
+      (db-admin/projection event)))

-(defn- apply-new-events [conn cached]
-  (let [new-events (event-store/read-all-events conn {:since (:event/global-revision (:last-event cached))})
-        last-event (last new-events)]
-    (if last-event
-      {:last-event last-event
-       :state (reduce update-projections (:state cached) new-events)}
-      cached)))
+(defn- apply-events [cache events]
+  (update cache :state #(reduce update-projections % events)))
+
+(defn- apply-new-events [cache conn]
+  (let [new-events (event-store/read-all-events conn {:since (:event/global-revision (:last-event cache))})]
+    (if (empty? new-events)
+      cache
+      (-> cache
+          (apply-events new-events)
+          (assoc :last-event (last new-events))))))

 (defn refresh-now! [conn]
   (let [cached @*cache
-        updated (apply-new-events conn cached)]
+        updated (apply-new-events cached conn)]
     (when-not (identical? cached updated)
       ;; with concurrent requests, only one of them will update the cache
       (when (compare-and-set! *cache cached updated)
         (log/info "Updated from revision" (:event/global-revision (:last-event cached))
-                  "to" (:event/global-revision (:last-event updated)))))))
+                  "to" (:event/global-revision (:last-event updated)))))
+
+    (let [transient-events (read-transient-events!)]
+      (when-not (empty? transient-events)
+        (swap! *cache apply-events transient-events)
+        (log/info "Updated with" (count transient-events) "transient events")))))

 (defn cached-state []
   (:state @*cache))
@@ -46,13 +67,32 @@
   "Calculates the current state from all events, including uncommitted ones,
    but does not update the cache (it could cause dirty reads to others)."
   [conn]
-  (:state (apply-new-events conn @*cache)))
+  (:state (apply-new-events @*cache conn)))

+;; TODO
+(declare refresh-async!)
+(def db-admin-injections
+  {:dispatch! (fn [event]
+                (prn :dispatch! event)
+                (dispatch-transient-event! event)
+                (refresh-async!))
+   :migrate-tenant-schema! (fn [args]
+                             (prn :migrate-tenant-schema! args))
+   :ensure-gis-user-present! (fn [args]
+                               (prn :ensure-gis-user-present! args))
+   :ensure-gis-user-absent! (fn [args]
+                              (prn :ensure-gis-user-absent! args))})
+
+(mount/defstate process-managers
+  :start (poller/create (fn []
+                          (db-admin/process-pending-changes! (cached-state) db-admin-injections)))
+  :stop (poller/shutdown! process-managers))

 (mount/defstate refresher
   :start (poller/create (fn []
                           (db/with-db [conn {}]
-                            (refresh-now! conn))))
+                            (refresh-now! conn))
+                          (poller/trigger! process-managers)))
   :stop (poller/shutdown! refresher))

 (defn refresh-async! []
@@ -73,4 +113,5 @@

 (comment
   (count (:state @*cache))
+  (refresh-async!)
   (refresh-now! db/database))


rewrite using loop and recur, fixes #2

rewrite using loop and recur, fixes #2

--- ann/src/ann/ab.clj
+++ ann/src/ann/ab.clj
@@ -7,8 +7,8 @@

 ;; Lib

-;; (def log println)
-(defn log [& body] nil)
+(def log println)
+;;(defn log [& body] nil)

 (defn abs
   [n]
@@ -45,12 +45,14 @@
 (defn train-perceptron
   "训练感知器，返回新的感知器"
   [perceptron inputs target]
-  (let [delta (- target (calc inputs perceptron))]
-    (map (fn [input weight]
-           (+ weight
-              (* delta (sgn input) study-rate)))
-         (concat [1] inputs)
-         perceptron)))
+  (let [delta (- target (calc inputs perceptron))
+        new-perceptron (map (fn [input weight]
+                              (+ weight
+                                 (* delta (sgn input) study-rate)))
+                            (concat [1] inputs)
+                            perceptron)]
+    (log "New Perceptron:" new-perceptron)
+    new-perceptron))

 ;;; Test

@@ -60,21 +62,24 @@
                        {:inputs [-1 -1] :target -1}]]
   ;; Train Data

-  (defn iter
-    [perceptron data-collection]
-    (defn all-good-enough?
-      []
-      (every? true?
-              (map (fn [{inputs :inputs target :target}]
-                     (good-enough? (- target (calc inputs perceptron))))
-                   data-collection)))
-    (doseq [{inputs :inputs target :target} data-collection]
-      (def perceptron (train-perceptron perceptron inputs target)))
-    (if (all-good-enough?)
-      perceptron
-      (iter perceptron data-collection)))
+  (defn all-good-enough?
+    [perceptron]
+    (every? true?
+            (map (fn [{inputs :inputs target :target}]
+                   (good-enough? (- target (calc inputs perceptron))))
+                 data-collection)))

-  (def perceptron (iter (create-perceptron) data-collection))
+  (def my-perceptron (loop [perceptron (create-perceptron)]
+                       (let [my-perc (loop [perc perceptron, data-collection data-collection]
+                                       (if (first data-collection)
+                                         (let [{inputs :inputs target :target} (first data-collection)]
+                                           (recur (train-perceptron perc inputs target) (rest data-collection)))
+                                         perc))]
+                         (if (all-good-enough? my-perc)
+                           my-perc
+                           (recur my-perc)))))
+
+  (log my-perceptron)

   ;; Test


adapt migrate to new insert-measurements signature

--- dev/migrate.clj
+++ dev/migrate.clj
@@ -66,7 +66,7 @@
                                               (map #(update-in % [:reading_metadata] convert-metadata %))
                                               (map #(dissoc % :metadata)))]
           (when measurements-with-metadata
-            (misc/insert-measurements store measurements-with-metadata 100)))
+            (misc/insert-measurements store s measurements-with-metadata 100)))
         (spit "/tmp/processed_sensors.txt" (str s "\n") :append true))))
   (log/info "Finished migrating reading metadata."))


Still debugging swarm, but a little better.

--- src/brevis/example/swarm.clj
+++ src/brevis/example/swarm.clj
@@ -21,7 +21,7 @@
 (def num-birds 30)
 (def avoidance (atom 0.2))
 (def clustering (atom 0.1))
-(def centering (atom 0.01))
+(def centering (atom 0.03))

 (def max-acceleration 2)

@@ -47,15 +47,11 @@

 (defn make-bird
   "Make a new bird with the specified program. At the specified location."
-  [position]
-  (-> {}
-      (make-real)
-      (make-box)
-;      (make-sphere)
-      (assoc :type :bird
-             :color [1 0 0]
-             :position position)
-      (make-collision-shape)))
+  [position]
+  (make-real {:type :bird
+              :color [1 0 0]
+              :position position
+              :shape (create-box)}))

 (defn random-bird
   "Make a new random bird."
@@ -129,8 +125,12 @@
 (defn initialize-simulation
   "This is the function where you add everything to the world."
   []
-  (let [birds (repeatedly num-birds random-bird)
-        floor (make-floor)]
-    {:objects (conj birds floor)}))
+  (init-world)
+  (let [birds (repeatedly num-birds random-bird)]
+    {:objects birds
+     :rotate-mode :none :translate-mode :none
+     :dt 0.1
+     :rot-x 0 :rot-y 0 :rot-z 0
+     :shift-x 0 :shift-y -20 :shift-z -50}))

-(start-gui initialize-simulation update-world 0.1)
+(start-gui initialize-simulation update-world)


change port back to 8080

change port back to 8080

--- src/kixi/eventlog/web_server.clj
+++ src/kixi/eventlog/web_server.clj
@@ -52,7 +52,7 @@

 (defn new-server [authentication? auth]
   (->WebServer {:verbose? true
-                :port 8081
+                :port 8080
                 :max-body
                 (* 16 1024 1024)}
                authentication?


GAWB-2189: don't remove empty expressions

--- src/cljs/main/broadfcui/page/workspace/method_configs/method_config_editor.cljs
+++ src/cljs/main/broadfcui/page/workspace/method_configs/method_config_editor.cljs
@@ -252,7 +252,6 @@
                         (->> (io-key (:inputs-outputs @state))
                              (map :name)
                              (map (juxt identity #(common/get-text refs (str ref-prefix "_" %))))
-                             (remove (comp empty? val))
                              (into {})))]
        (swap! state assoc :blocker "Updating...")
        (endpoints/call-ajax-orch
@@ -335,4 +334,6 @@
            original-inputs-outputs (:original-inputs-outputs @state)
            method-ref (-> original-loaded-config :methodConfiguration :methodRepoMethod)]
        (swap! state assoc :loaded-config original-loaded-config :inputs-outputs original-inputs-outputs)
-       ((@refs "methodDetailsViewer") :load-agora-method method-ref)))})+       ((@refs "methodDetailsViewer") :load-agora-method {:namespace (:methodNamespace method-ref)
+                                                          :name (:methodName method-ref)
+                                                          :snapshotId (:methodVersion method-ref)})))})


Clean up flag from tracking additions and removals

- Tracking if the HAMT has been modified is unnecessary
- Changed from `changed?` to more semantic meanings (`added-leaf?` and `removed-leaf`)

--- src/main/cljs/lean_map/core.cljs
+++ src/main/cljs/lean_map/core.cljs
@@ -9,7 +9,7 @@

 (declare NodeSeq HashCollisionNode TransientHashMap PersistentHashMap)

-(deftype Box [^:mutable added ^:mutable modified])
+(deftype Box [^:mutable val])

 (declare create-inode-seq create-array-node-seq create-node)

@@ -103,25 +103,24 @@
         (create-inode-seq arr 0 nodes cursors-lengths 0 0)
         (NodeSeq. nil arr 0 nodes cursors-lengths 0 (dec (.data-arity inode)) nil))))

-  (inode-assoc [inode aedit shift hash key val changed?]
+  (inode-assoc [inode aedit shift hash key val added-leaf?]
     (let [bit (bitpos hash shift)]
       (cond
         (not (zero? (bit-and datamap bit)))
         (let [idx (bitmap-indexed-node-index datamap bit)
               k (aget arr (* 2 idx))]
-          (set! (.-modified changed?) true)
           (if (key-test k key)
             (.copy-and-set-value inode aedit bit val)
             (let [v (aget arr (inc (* 2 idx)))
                   new-node (.merge-two-kv-pairs inode aedit (+ shift 5) k v hash key val)]
-              (set! (.-added changed?) true)
+              (set! (.-val added-leaf?) true)
               (.copy-and-migrate-to-node inode aedit bit new-node))))
         (not (zero? (bit-and nodemap bit)))
         (let [sub-node (aget arr (node-at arr nodemap bit))
-              sub-node-new (.inode-assoc sub-node aedit (+ shift 5) hash key val changed?)]
-          (if ^boolean (.-modified changed?)
-            (.copy-and-set-node inode aedit bit sub-node-new)
-            inode))
+              sub-node-new (.inode-assoc sub-node aedit (+ shift 5) hash key val added-leaf?)]
+          (if (identical? sub-node sub-node-new)
+            inode
+            (.copy-and-set-node inode aedit bit sub-node-new)))
         :else
         (let [n (alength arr)
               idx (* 2 (bitmap-indexed-node-index datamap bit))
@@ -130,8 +129,7 @@
           (aset new-arr idx key)
           (aset new-arr (inc idx) val)
           (array-copy arr idx new-arr (+ 2 idx) (- n idx))
-          (set! (.-added changed?) true)
-          (set! (.-modified changed?) true)
+          (set! (.-val added-leaf?) true)
           (BitmapIndexedNode. aedit (bit-or datamap bit) nodemap new-arr)))))

   (has-nodes? [_]
@@ -205,14 +203,14 @@
   (single-kv? [_]
     (and (zero? nodemap) (== 1 (bit-count datamap))))

-  (inode-without [inode wedit shift hash key changed?]
+  (inode-without [inode wedit shift hash key removed-leaf?]
     (let [bit (bitpos hash shift)]
       (cond
         (not (zero? (bit-and datamap bit)))
         (let [idx (bitmap-indexed-node-index datamap bit)]
           (if (key-test key (aget arr (* 2 idx)))
             (do
-              (set! (.-modified changed?) true)
+              (set! (.-val removed-leaf?) true)
               (if (and (== 2 (bit-count datamap)) (zero? nodemap))
                (let [new-datamap (if (zero? shift) (bit-xor datamap bit) (bitpos hash 0))]
                  (if (zero? idx)
@@ -222,14 +220,14 @@
             inode))
         (not (zero? (bit-and nodemap bit)))
         (let [sub-node (aget arr (node-at arr nodemap bit))
-              sub-node-new (.inode-without sub-node wedit (+ shift 5) hash key changed?)]
-          (if ^boolean (.-modified changed?)
+              sub-node-new (.inode-without sub-node wedit (+ shift 5) hash key removed-leaf?)]
+          (if (identical? sub-node sub-node-new)
+            inode
             (if ^boolean (.single-kv? sub-node-new)
               (if (and (zero? datamap) (== 1 (bit-count nodemap)))
                 sub-node-new
                 (.copy-and-migrate-to-inline inode wedit bit sub-node-new))
-              (.copy-and-set-node inode wedit bit sub-node-new))
-            inode))
+              (.copy-and-set-node inode wedit bit sub-node-new))))
         :else
         inode)))

@@ -264,44 +262,39 @@
                             ^:mutable cnt
                             ^:mutable arr]
   Object
-  (persistent-inode-assoc [inode idx hedit key val changed?]
+  (persistent-inode-assoc [inode idx hedit key val added-leaf?]
     (if (== idx -1)
       (let [len     (* 2 cnt)
             new-arr (make-array (+ len 2))]
         (array-copy arr 0 new-arr 0 len)
         (aset new-arr len key)
         (aset new-arr (inc len) val)
-        (set! (.-added changed?) true)
-        (set! (.-modified changed?) true)
+        (set! (.-val added-leaf?) true)
         (HashCollisionNode. hedit collision-hash (inc cnt) new-arr))
       (if (= (aget arr idx) val)
         inode
-        (do
-          (set! (.-modified changed?) true)
-          (HashCollisionNode. hedit collision-hash cnt (clone-and-set arr (inc idx) val))))))
-
-  (mutable-inode-assoc [inode idx key val changed?]
+        (HashCollisionNode. hedit collision-hash cnt (clone-and-set arr (inc idx) val)))))
+
+  (mutable-inode-assoc [inode idx key val added-leaf?]
     (if (== idx -1)
       (let [new-arr (make-array (* 2 (inc cnt)))]
         (array-copy arr 0 new-arr 0 (* 2 cnt))
         (aset arr (* 2 cnt) key)
         (aset arr (inc (* 2 cnt)) val)
-        (set! (.-added changed?) true)
-        (set! (.-modified changed?) true)
+        (set! (.-val added-leaf?) true)
         (set! cnt (inc cnt)))
       (when-not (identical? (aget arr (inc idx)) val)
-        (set! (.-modified changed?) true)
         (aset arr (inc idx) val)))
     inode)

-  (inode-assoc [inode hedit _ hash key val changed?]
+  (inode-assoc [inode hedit _ hash key val added-leaf?]
     (assert (== hash collision-hash))
     (let [idx (hash-collision-node-find-index arr cnt key)]
       (if ^boolean hedit
         (if ^boolean (can-edit edit hedit)
-         (.mutable-inode-assoc inode idx key val changed?)
-         (.mutable-inode-assoc (HashCollisionNode. hedit hash cnt (aclone arr)) idx key val changed?))
-        (.persistent-inode-assoc inode idx hedit key val changed?))))
+         (.mutable-inode-assoc inode idx key val added-leaf?)
+         (.mutable-inode-assoc (HashCollisionNode. hedit hash cnt (aclone arr)) idx key val added-leaf?))
+        (.persistent-inode-assoc inode idx hedit key val added-leaf?))))

   (has-nodes? [_]
     false)
@@ -333,18 +326,18 @@
             (key-test key (aget arr idx)) [(aget arr idx) (aget arr (inc idx))]
             :else                  not-found)))

-  (inode-without [inode wedit shift hash key changed?]
+  (inode-without [inode wedit shift hash key removed-leaf?]
     (let [idx (hash-collision-node-find-index arr cnt key)]
       (if (== idx -1)
         inode
         (do
-          (set! (.-modified changed?) true)
+          (set! (.-val removed-leaf?) true)
           (case cnt
             1
             (.-EMPTY BitmapIndexedNode)
             2
             (let [idx (if (key-test key (aget arr 0)) 2 0)]
-              (.inode-assoc (.-EMPTY BitmapIndexedNode) wedit 0 hash (aget arr idx) (aget arr (inc idx)) changed?))
+              (.inode-assoc (.-EMPTY BitmapIndexedNode) wedit 0 hash (aget arr idx) (aget arr (inc idx)) removed-leaf?))
             (HashCollisionNode. wedit collision-hash (dec cnt) (remove-pair arr (quot idx 2))))))))

   (kv-reduce [inode f init]
@@ -463,11 +456,11 @@

   IAssociative
   (-assoc [coll k v]
-    (let [changed? (Box. false false)
-          new-root (.inode-assoc root nil 0 (hash k) k v changed?)]
+    (let [added-leaf? (Box. false)
+          new-root (.inode-assoc root nil 0 (hash k) k v added-leaf?)]
       (if (identical? new-root root)
         coll
-        (PersistentHashMap. meta (if ^boolean (.-added changed?) (inc cnt) cnt) new-root  nil))))
+        (PersistentHashMap. meta (if ^boolean (.-val added-leaf?) (inc cnt) cnt) new-root  nil))))

   (-contains-key? [coll k]
     (if (nil? root)
@@ -482,7 +475,7 @@
   (-dissoc [coll k]
     (if (nil? root)
       coll
-      (let [new-root (.inode-without root nil 0 (hash k) k (Box. false false))]
+      (let [new-root (.inode-without root nil 0 (hash k) k (Box. false))]
         (if (identical? new-root root)
           coll
           (PersistentHashMap. meta (dec cnt) new-root nil)))))
@@ -513,12 +506,12 @@

   (assoc! [tcoll k v]
     (if edit
-      (let [changed? (Box. false false)
-            node (.inode-assoc root edit 0 (hash k) k v changed?)]
+      (let [added-leaf? (Box. false)
+            node (.inode-assoc root edit 0 (hash k) k v added-leaf?)]
         (if (identical? node root)
           nil
           (set! root node))
-        (if ^boolean (.-added changed?)
+        (if ^boolean (.-val added-leaf?)
           (set! count (inc count)))
         tcoll)
       (throw (js/Error. "assoc! after persistent!"))))
@@ -527,12 +520,12 @@
     (if edit
       (if (nil? root)
         tcoll
-        (let [removed-leaf? (Box. false false)
+        (let [removed-leaf? (Box. false)
               node (.inode-without root edit 0 (hash k) k removed-leaf?)]
           (if (identical? node root)
             nil
             (set! root node))
-          (if ^boolean (.-modified removed-leaf?)
+          (if ^boolean (.-val removed-leaf?)
             (set! count (dec count)))
           tcoll))
       (throw (js/Error. "dissoc! after persistent!"))))


add cache path config vars

add cache path config vars

--- src/main/cljs_api_gen/config.clj
+++ src/main/cljs_api_gen/config.clj
@@ -2,6 +2,11 @@

 ;; location of manual cljsdoc files
 (def cljsdoc-dir "cljsdoc")
+
+;; cache directory
+(def cache-dir ".api-cache")
+(def edn-prelim-file "cljs-api-0.edn")
+(def edn-cljsdoc-file "cljsdoc.edn")

 ;; location of the clojure & clojurescript repos to parse
 (def repos-dir "repos")


update docset builder to reflect new file structure

--- src/main/cljs_api_gen/docset.clj
+++ src/main/cljs_api_gen/docset.clj
@@ -135,9 +135,9 @@
     (println "Adding sections to index database...")
     (j/insert! sqlite-db :searchIndex
        ;; insert categories
-       {:name "Syntax" :type "Category" :path (resolve-path "INDEX.html#syntax")}
-       {:name "Library API"  :type "Category" :path (resolve-path "INDEX.html#library-api")}
-       {:name "Compiler API" :type "Category" :path (resolve-path "INDEX.html#compiler-api")}
+       {:name "Syntax" :type "Category" :path (resolve-path "refs/syntax.html")}
+       {:name "Library API"  :type "Category" :path (resolve-path "refs/library.html")}
+       {:name "Compiler API" :type "Category" :path (resolve-path "refs/compiler.html")}

        ;; insert sections
        {:name "Overview"                :type "Section" :path (resolve-path "INDEX.html")}
@@ -147,49 +147,60 @@

     ;; insert namespaces
     (println "Adding namespaces to index database...")
-    (let [get-api-ns-pairs
-          (fn [[api-type {:keys [symbol-names]}]]
-            (for [s symbol-names]
-              (let [[ns-] (split-ns-and-name s)]
-                [api-type ns-])))
-          pairs (->> (:api result)
-                     (mapcat get-api-ns-pairs)
-                     (set))]
+    (let [ns->entry
+          (fn [api-type ns-]
+            (let [ns-meta (get-in result [:namespaces ns-])
+                  ns-display (or (:display ns-meta) ns-)
+                  ns-link (resolve-path "refs/" (name api-type) "/" ns- ".html")]
+              {:name ns-display
+               :type "Namespace"
+               :path ns-link}))
+
+          api-entries
+          (fn [api-type]
+            (let [namespaces (get-in result [:api api-type :namespace-names])]
+              (map (partial ns->entry api-type) namespaces)))]
+
       (apply j/insert! sqlite-db :searchIndex
-        (for [[api-type ns-] pairs]
-          (let [ns-meta (get-in result [:namespaces ns-])
-                ns-display (or (:display ns-meta) ns-)
-                ns-link (resolve-path "INDEX.html#" (md-header-link ns-display))]
-            {:name ns-display :type "Namespace" :path ns-link}))))
+             (mapcat api-entries [:library :compiler])))

     ;; insert symbols
     (println "Adding symbols to index database...")
-    (let [refs-path (str docset-docs-path "/" (resolve-path "refs"))]
+    (let [;; We want to retrieve the full name of the symbol belonging to
+          ;; this file.  We do this by decoding the original filename of
+          ;; the generated page.
+          ;;
+          ;; But, httrack can rename files by appending number suffixes
+          ;; to prevent collision on case-insensitive file systems. This
+          ;; is actually really helpful since it allows us to maintain
+          ;; compatibility with Windows and Mac, but prevents us from
+          ;; decoding the filenames straighaway.
+          ;;
+          ;; Luckily, httrack adds an html comment stamp containing the
+          ;; original filename, which we can parse:
+          ;;    <!-- Mirrored from <url-here> by HTTrack Website Copier ... -->
+          symbol-file->entry
+          (fn [ref-file]
+            (let [encoded-name
+                  (second
+                    (re-find #"github\.com/cljsinfo/cljs-api-docs/blob/catalog/refs/(.*)\.md "
+                             (slurp ref-file)))
+                  full-name (decode-fullname encoded-name)
+                  item (get syms full-name)]
+              {:name (dash-name item)
+               :type (type->dash (:type item))
+               :path (resolve-path "refs/" (:ns item) "/" (base-name ref-file))}))
+
+          ns-entries
+          (fn [ns-]
+            (let [ns-dir (str docset-docs-path "/" (resolve-path "refs/" ns-))
+                  symbol-files (list-dir ns-dir)]
+              (map symbol-file->entry symbol-files)))
+
+          namespaces (keys (:namespaces result))]
+
       (apply j/insert! sqlite-db :searchIndex
-        (for [ref-file (list-dir refs-path)]
-          (let [;; We want to retrieve the full name of the symbol belonging to
-                ;; this file.  We do this by decoding the original filename of
-                ;; the generated page.
-                ;;
-                ;; But, httrack can rename files by appending number suffixes
-                ;; to prevent collision on case-insensitive file systems. This
-                ;; is actually really helpful since it allows us to maintain
-                ;; compatibility with Windows and Mac, but prevents us from
-                ;; decoding the filenames straighaway.
-                ;;
-                ;; Luckily, httrack adds an html comment stamp containing the
-                ;; original filename, which we can parse:
-                ;;    <!-- Mirrored from <url-here> by HTTrack Website Copier ... -->
-                encoded-name
-                (second
-                  (re-find #"github\.com/cljsinfo/cljs-api-docs/blob/catalog/refs/(.*)\.md "
-                           (slurp ref-file)))
-                full-name (decode-fullname encoded-name)
-                item (get syms full-name)]
-            {:name (dash-name item)
-             :type (type->dash (:type item))
-             :path (resolve-path "refs/" (base-name ref-file))}
-            ))))
+        (mapcat ns-entries namespaces)))

     ;; create the tar file
     (println "Creating final docset tar file...")


stub out some arena creation functions

stub out some arena creation functions

--- src/clj/battlebots/arena.clj
+++ src/clj/battlebots/arena.clj
@@ -2,9 +2,34 @@

 (def arena-key {:open " "
                 :bot "@"
-                :block "X"})
+                :block "X"
+                :food "+"
+                :poison "-"})

-(defn arena
+(defn empty-arena
   [dimx dimy]
-  (vec (replicate (vec (replicate (:open arena-key) dimy)) dimx)))
+  (vec (replicate dimx (vec (replicate dimy (:open arena-key))))))

+(defn blocks
+  "sprinkle blocks around the arena argument and return a new arena
+  make sure there are no inaccessible areas"
+  [arena]
+  arena)
+
+(defn food
+  "sprinkle food around the arena argument and return a new arena"
+  [arena]
+  arena)
+
+(defn poison
+  "sprinkle poison around the arena argument and return a new arena"
+  [arena]
+  arena)
+
+(defn new-arena
+  "compose all arena building functions to make a fresh new arena"
+  [dimx dimy]
+  ((comp poison food blocks empty-arena) dimx dimy))
+
+
+


1msg/s throttling

1msg/s throttling

--- src/clj/breakfast/server.clj
+++ src/clj/breakfast/server.clj
@@ -73,12 +73,14 @@
 ;; https://github.com/brunoV/throttler
 ;;(def +# (throttle-fn + 100 :second))

-(defn send-message
-  "Send a message to a IRC channel."
+(defn send-message-raw
+  "Send a message to a IRC channel. Warning: unthrottled."
   [conn nick msg]
-  (throttle-fn
-   (irc/message conn "#clojurecup-breakfast" (str nick " says: " msg))
-   1 :second))
+  (irc/message conn "#clojurecup-breakfast" (str nick " says: " msg)))
+
+(def send-message-throttled
+  (throttle-fn send-message-raw 1 :second))
+
 ;; does this work? try 1 first. then 0.5.

 ;; based on http://www.reddit.com/r/irc/comments/1rdejj/freenode_flood_limits/
@@ -117,7 +119,7 @@
             :chsk/ws-ping (println "ws-ping")
             :irc/message (do
                            (println (str "nick " (:uid load) " msg " (:msg load)))
-                           (send-message conn (:uid load) (:msg load)))  ;; buffering? nick msg
+                           (send-message-throttled conn (:uid load) (:msg load)))  ;; buffering? nick msg
             )))))
  ;; (str "nick " uid " msg " msg)))
 ;; :irc/message {:uid "user_42", :msg "foobar"}]


changed migrations

changed migrations

--- src/clj/lobos/migrations.clj
+++ src/clj/lobos/migrations.clj
@@ -10,17 +10,20 @@
 (defmigration add-recipes-table
 	(up [] (create
 		(table :recipes
-			(integer :id :primary-key :auto-inc )
-			(varchar :name 100 )
-			(timestamp :created (default (now))))))
+			(integer 		:id :primary-key :auto-inc )
+			(varchar 		:name 100 )
+			(varchar 		:instructions 1000)
+			(varchar 		:avatar_url 100)
+			(timestamp 	:created (default (now))))))
 	(down [] (drop (table :recipes ))))

 (defmigration add-ingredients-table
 	(up [] (create
 					(table :ingredients
-						(integer :id :primary-key :auto-inc )
-						(varchar :name 250)
-						(varchar :units 100)
-						(timestamp :created (default (now)))
-						(integer :recipe_id [:refer :recipes :id] :not-null))))
+						(integer 		:id :primary-key :auto-inc )
+						(varchar 		:name 250)
+						(varchar 		:units 100)
+						(double			:quantity)
+						(timestamp 	:created (default (now)))
+						(integer 		:recipe_id [:refer :recipes :id] :not-null))))
 	(down [] (drop (table :ingredients ))))


Fixed bug which prevented saving page content correctly

--- src/clj/salava/page/main.clj
+++ src/clj/salava/page/main.clj
@@ -152,7 +152,7 @@
                         (assoc :page_id page-id
                                :block_order block-index))
               id (and (:id block)
-                      (some #(= (:id %) (:id block)) page-blocks))]
+                      (some #(and (= (:type %) (:type block)) (= (:id %) (:id block))) page-blocks))]
           (case (:type block)
             "heading" (if id
                         (update-heading-block! block (get-db ctx))
@@ -175,7 +175,7 @@
                     (update-tag-block! block (get-db ctx))
                     (insert-tag-block! block (get-db ctx))))))
       (doseq [old-block page-blocks]
-        (if-not (some #(= (:id old-block) (:id %)) blocks)
+        (if-not (some #(and (= (:type old-block) (:type %)) (= (:id old-block) (:id %))) blocks)
           (delete-block! ctx old-block)))
       {:status "success" :message (t :page/Pagesavedsuccessfully)})
     (catch Object _


unused

unused

--- src/clj_ptt_crawler/core.clj
+++ src/clj_ptt_crawler/core.clj
@@ -1,7 +0,0 @@
-(ns clj-ptt-crawler.core
-  (:gen-class))
-
-(defn -main
-  "I don't do a whole lot ... yet."
-  [& args]
-  (println "Hello, World!"))


added a few questions

added a few questions

--- src/cljs/netrunner/help.cljs
+++ src/cljs/netrunner/help.cljs
@@ -1,45 +1,90 @@
 (ns netrunner.help
   (:require [om.core :as om :include-macros true]
-            [sablono.core :as sab :include-macros true]))
+            [sablono.core :as sab :include-macros true]
+            [clojure.string :refer [split]]))

 (def app-state (atom {}))

 (def help-contents
-  ;; every header tag MUST have an ID here, defined with # in the keyword
-  (list [:h3#faq "Frequently Asked Questions"]
+  "Sablono tags with FAQ about jinteki.net. Every header tag MUST have an ID here, defined with # in the keyword."
+  (list [:h3#general "General"]
+
+        [:h4#documentation "Is there more documentation on how to use jinteki.net?"]
+        [:p "Read the "
+         [:a {:href "https://github.com/mtgred/netrunner/wiki/Jinteki.net-Guide" :target "_blank"}
+          "Jinteki.net Guide"] " on the GitHub wiki."]
+
+        [:h3#site "Jinteki.net site"]
+
         [:h4#avatar "How can I change my avatar?"]
         [:p "Go to " [:a {:href "http://gravatar.com" :target "_blank"} "gravatar.com"]
          " and create an account with the same email as the one used to register on Jinteki.net."]

-        [:h4#donation "How can I make a donation?"]
+        [:h4#bestbrowser "What is the best supported browser?"]
+        [:p "Google Chrome or Firefox on a desktop or laptop is recommended. Safari should work fine too. "
+         "Touchscreen devices (smartphones, tablets etc.) are currently not supported."]
+
+        [:h3#cards "Cards and rules"]
+
+        [:h3#troubleshooting "Troubleshooting"]
+
+        [:h4#touchproblems "The website doesn't work on my touchscreen device."]
+        [:p "Touchscreen devices are currently not supported. See answer to " [:a {:href "#bestbrowser"} "this question"]
+         " for best browsers to use with Jinteki.net."]
+
+        [:h4#toomanycards "There are too many cards or menu options to fit the screen."]
+        [:p "Decrease the zoom level of your browser and you should be able to see everything. If you are using "
+         "Chrome, you can do it by pressing CTRL and - (minus). If you are using Firefox, you may need to install "
+         [:a {:href "https://addons.mozilla.org/pl/firefox/addon/zoom-page/"} "Zoom Page addon"] " before the zoom works correctly."]
+
+        [:h4#zerogames "Whenever I connect to the site, I see there are 0 games in the lobby."]
+        [:p "This is most likely a websocket issue. Check if your network filters let through traffic from ws.jinteki.net. "
+         "Whitelisting *.jinteki.net should solve the problem."]
+
+        [:h3#getinv "Getting involved"]
+
+        [:h4#bugs "How can I report a bug?"]
+        [:p "The best place to report bugs is the " [:a {:href "https://github.com/mtgred/netrunner/issues"} "GitHub issue tracker"]
+         ". Before reporting, it is best to make a quick search to see if it's already been reported. "
+         "If the bug concerns a card, look it up in "
+         [:a {:href "https://docs.google.com/spreadsheets/d/1ICv19cNjSaW9C-DoEEGH3iFt09PBTob4CAutGex0gnE/pubhtml"} "Card implementation status"]
+         " - the card in question may be unimplemented yet."]
+
+        [:h4#features "How can I suggest a feature?"]
+        [:p "Same as bugs - feature requests should go on the " [:a {:href "https://github.com/mtgred/netrunner/issues"} "GitHub issue tracker"]
+         ". Again, it's best to make a quick search first to avoid duplicating existing issues."]
+
+        [:h4#donations "How can I make a donation?"]
         [:p "Donation info can be found on the " [:a {:href "/about"} "About"] " page."]

-        [:h4#toomanycards "There are too many cards or menu options to fit the screen."]
-        [:p "Decrease the zoom level of your browser and you should be able to see everything."]
+        [:h4#devs "How can I help with the coding/webdesign?"]
+        [:p "Visit the project page on " [:a {:href "https://github.com/mtgred/netrunner/"} "GitHub"] " and fork "
+         "the repository. Implement the changes you were planning on doing and create a PR (Pull Request). If you are in "
+         "need of some ideas, check out " [:a {:href "https://github.com/mtgred/netrunner/labels/easy"} "issues marked 'easy' on GitHub"] "."]
+        [:p "After two of your PRs have been merged into the master branch, send an e-mail to "
+         [:a {:href "mailto:mtgred@gmail.com"} "mtgred@gmail.com"] " stating who you are on GitHub and ask for access "
+         "to Jinteki.net Slack, so you can get in better contact with the dev team."]

-        [:h3#lessfaq "Less Frequently Asked Questions"]
-        [:h4#bestbrowser "What is the best supported browser?"]
-        [:p "Google Chrome on a desktop or laptop is recommended. Firefox and Safari should work fine too."]
-
-        [:h4#documentation "Is there documentation on how to use jinteki.net?"]
-        [:p "Read the "
-         [:a {:href "https://github.com/mtgred/netrunner/wiki/Jinteki.net-Guide" :target "_blank"}
-          "Jinteki.net Guide"] " on the Github wiki." ]))
+        [:h4#awesome "Why is this site so awesome?"]
+        [:p "Because We Built It."]))

 (def help-toc
-  [:nav {:role "navigation" :class "table-of-contents"} [:ul
-   (for [tag help-contents
-         :let [tagkey (name (first tag))
-               tagcontents (second tag)
-               tagname (first (clojure.string/split tagkey #"#"))
-               tagid (second (clojure.string/split tagkey #"#"))]
-         :when (or (= "h3" tagname) (= "h4" tagname))]
-     [:li [:a {:href (str "#" tagid)} tagcontents]])]])
+  "Generates list serving as help's table of contents. Parses help-contents and looks for :h3 and :h4 tags."
+  [:nav {:role "navigation" :class "table-of-contents"}
+   [:ul
+    (for [tag help-contents
+          :let [tagkey (name (first tag))
+                tagcontents (second tag)
+                tagname (first (split tagkey #"#"))
+                tagid (second (split tagkey #"#"))]
+          :when (= "h4" tagname)]
+      [:li [:a (when tagid {:href (str "#" tagid)}) tagcontents]])]])

 (defn help [cursor owner]
   (om/component
     (sab/html
       [:div.help.panel.blue-shade
+       [:h3 "Table of contents"]
        help-toc
        help-contents])))


Fix noise functions

Fix noise functions

--- src/cljx/robinson/noise.cljx
+++ src/cljx/robinson/noise.cljx
@@ -14,6 +14,7 @@
 (def ^:private grad3 [[ 1  1  0]
                       [-1  1  0]
                       [ 1 -1  0]
+                      [-1 -1  0]
                       [ 1  0  1]
                       [-1  0  1]
                       [ 1  0 -1]
@@ -54,7 +55,7 @@
                       [-1,  1, -1,  0]
                       [-1, -1,  1,  0]
                       [-1, -1, -1,  0]])
-(def ^:private f2 (dec (* 0.5 #+clj  (Math/sqrt 3.0)
+(def ^:private f2 (* 0.5 (dec #+clj  (Math/sqrt 3.0)
                               #+cljs (.sqrt js/Math 3.0))))
 (def ^:private g2 (/ (- 3.0
                         #+clj  (Math/sqrt 3.0)
@@ -93,13 +94,13 @@
   (create-noise rr/*rnd*))
   ([rnd]
   (let [p           (rr/rnd-shuffle rnd (vec (range 256)))
-        perm        (concat p p)
+        perm        (vec (concat p p))
         perm-mod-12 (mapv (fn [n] (mod n 12)) perm)]
     (reify Noise
       (snoise [this xin yin]
         (let [s (* f2 (+ xin yin))
-              i (fast-floor (* xin s))
-              j (fast-floor (* yin s))
+              i (fast-floor (+ xin s))
+              j (fast-floor (+ yin s))
               t (* (+ i j) g2)
               X0 (- i t)
               Y0 (- j t)
@@ -134,3 +135,22 @@
         [this x y]
         (+ 0.5 (* 0.5 (snoise this x y))))))))

+
+
+
+;; REPL code for displaying noise as ascii art
+;;(def px (partition 200 (for [x (range -100 100) y (range -100 100)] (noise n (/ x 10) (/ y 10)))))
+
+;;(def ascii-chars [\# \A \@ \$ \% \= \+ \* \: \, \. \space])
+
+;;(def n (create-noise))
+
+;;(doseq [line px]
+;;(println
+;;  (apply str (map (fn [c]
+;;                    (let [idx (if (zero? c)
+;;                                  (dec (count ascii-chars))
+;;                                  (- (count ascii-chars)
+;;                                     (* c (count ascii-chars))))]
+;;                      (nth ascii-chars (max idx 0))))
+;;                  line))))


More ways to reduce MR input.

More ways to reduce MR input.

--- src/clojure/parkour/core.clj
+++ src/clojure/parkour/core.clj
@@ -1,20 +1,9 @@
 (ns parkour.core
   (:require [clojure.core.reducers :as r]
             [clojure.core.protocols :as ccp]
-            [clojure.string :as str]
-            [cheshire.core :as json])
-  (:import [org.apache.hadoop.io Text NullWritable]
-           [org.apache.hadoop.mapreduce ReduceContext TaskInputOutputContext]
-           [org.apache.hadoop.mapreduce.lib.output MultipleOutputs]
-           [org.apache.avro Schema Schema$Parser]
-           [org.apache.avro.generic GenericData GenericData$Record]))
-
-(set! *warn-on-reflection* true)
-
-(defmacro returning
-  "Evaluates the result of expr, then evaluates the forms in body (presumably
-for side-effects), then returns the result of expr."
-  [expr & body] `(let [value# ~expr] ~@body value#))
+            [clojure.string :as str])
+  (:import [org.apache.hadoop.mapreduce ReduceContext TaskInputOutputContext]
+           [org.apache.hadoop.mapreduce.lib.output MultipleOutputs]))

 (defmacro ^:private context-reducer
   [nextf dataf]
@@ -32,13 +21,31 @@
                    [(.getCurrentKey context)
                     (.getCurrentValue context)]))

+(defn mr-keys
+  [^TaskInputOutputContext context]
+  (context-reducer (.nextKeyValue context)
+                   (.getCurrentKey context)))
+
+(defn mr-vals
+  [^TaskInputOutputContext context]
+  (context-reducer (.nextKeyValue context)
+                   (.getCurrentValue context)))
+
 (defn mr-keyvalgroups
   [^ReduceContext context]
   (context-reducer (.nextKey context)
                    [(.getCurrentKey context)
                     (.getValues context)]))

+(defn mr-keygroups
+  [^ReduceContext context]
+  (context-reducer (.nextKey context)
+                   (.getCurrentKey context)))
+
+(defn mr-valgroups
+  [^ReduceContext context]
+  (context-reducer (.nextKey context) (.getValues context)))
+
 (defn emit-keyvals
   [^TaskInputOutputContext context coll]
   (r/reduce (fn [_ [k v]] (.write context k v)) nil coll))
-


Fix the way the assertion happens.

Fix the way the assertion happens.

--- test/onyx/log/grouping_generative_test.clj
+++ test/onyx/log/grouping_generative_test.clj
@@ -176,12 +176,14 @@
      (let [[t1 t2 t3] (:tasks (:args rets))]
        ;; If the job is submitted first, the second case occurs. Otherwise the first
        ;; case pins task B to 4 peers.
-       (or (is (and (= 5 (count (get (get (:allocations replica) job-4-id) t1)))
+       (is
+        (= true
+           (or (and (= 5 (count (get (get (:allocations replica) job-4-id) t1)))
                     (= 4 (count (get (get (:allocations replica) job-4-id) t2)))
-                    (= 5 (count (get (get (:allocations replica) job-4-id) t3)))))
-           (is (and (= 5 (count (get (get (:allocations replica) job-4-id) t1)))
+                    (= 5 (count (get (get (:allocations replica) job-4-id) t3))))
+               (and (= 5 (count (get (get (:allocations replica) job-4-id) t1)))
                     (= 5 (count (get (get (:allocations replica) job-4-id) t2)))
-                    (= 4 (count (get (get (:allocations replica) job-4-id) t3))))))))))
+                    (= 4 (count (get (get (:allocations replica) job-4-id) t3)))))))))))

 (deftest min-peers-not-enough-peers
   (let [rets (api/create-submit-job-entry


(PDB-3240) Switched test logging predicates to use Event objects

The 'with-log-suppressed-unless-notable' macro passes it's predicates
log event objects, NOT the Clojure map versions created by the
event->map function. The predicates were written to expect the map
version. This resulted in ALL log messages being filtered out. This
commit switches those predicates to call methods on the log event
instances directly.

--- test/puppetlabs/puppetdb/testutils/log.clj
+++ test/puppetlabs/puppetdb/testutils/log.clj
@@ -10,7 +10,8 @@
    [ch.qos.logback.core.spi LifeCycle]
    [ch.qos.logback.classic Level Logger]
    [ch.qos.logback.classic.encoder PatternLayoutEncoder]
-   [org.slf4j LoggerFactory]))
+   [org.slf4j LoggerFactory]
+   [ch.qos.logback.classic.spi ILoggingEvent]))

 (defmacro with-started
   "Ensures that if a given name's init form executes without throwing
@@ -196,10 +197,15 @@
 ;;The below functions are useful with
 ;;puppetlabs.trapperkeeper.testutils.logging/with-log-suppressed-unless-notable

-(def critical-errors (comp #{:fatal :error} :level))
+(defn critical-errors
+  [^ILoggingEvent event]
+  (= Level/ERROR
+     (.getLevel event)))

 (defn starting-with
   "Filters log events that have a message starting with `string`"
   [string]
-  (fn [event]
-    (.startsWith (:message event) string)))
+  (fn [^ILoggingEvent event]
+    (-> event
+        .getMessage
+        (.startsWith string))))


Throw some sleep in there just to see if it helps.

--- integration-tests/src/test/clojure/immutant/integs/basic.clj
+++ integration-tests/src/test/clojure/immutant/integs/basic.clj
@@ -28,11 +28,13 @@
                         }))

 (deftest simple "it should work"
+  (Thread/sleep 5000)
   (let [result (client/get "http://localhost:8080/basic-ring")]
     ;(println "RESPONSE" result)
     (is (.startsWith (result :body) "Hello from Immutant!"))))

 (deftest app-should-have-its-config
+  (Thread/sleep 5000)
   (let [result (client/get "http://localhost:8080/basic-ring")]
     ;(println "RESPONSE" result)
     (is (.contains (result :body) ":ham :biscuit"))))


No unnamed funcs

No unnamed funcs

--- src/obb_rules/actions/rotate.clj
+++ src/obb_rules/actions/rotate.clj
@@ -18,7 +18,7 @@
 (defn build-rotate
   "Builds a rotate action on a board"
   [[player coord new-direction]]
-  (fn [board]
+  (fn rotator [board]
     (let [element (get-element board coord)]
       (if-let [error (rotate-restrictions player element)]
         (action-failed error)


Do not allow conflict with aeron property and command line arg.

--- src/leiningen/new/onyx_app/src/onyx_app/launcher/aeron_media_driver.clj
+++ src/leiningen/new/onyx_app/src/onyx_app/launcher/aeron_media_driver.clj
@@ -5,16 +5,20 @@
            [uk.co.real_logic.aeron.driver MediaDriver MediaDriver$Context ThreadingMode]))

 (defn -main [& [threading-mode]]
+  (when (and (System/getProperty "aeron.threading.mode")
+             threading-mode)
+    (throw (Exception. "Cannot set both aeron.threading.mode property and threading-mode command-line arg")))
+
   (let [threading-mode (cond (or (nil? threading-mode)
-                                 (= threading-mode "dedicated"))
-                                 ThreadingMode/DEDICATED
-                                 (= threading-mode "shared")
-                                 ThreadingMode/SHARED
-                                 (= threading-mode "shared-network")
-                                 ThreadingMode/SHARED_NETWORK)
-        _ (println "Starting media driver with threading mode: " threading-mode)
-        ctx (-> (MediaDriver$Context.)
-                (.threadingMode threading-mode))
+                                 (= threading-mode "shared"))
+                             ThreadingMode/SHARED
+                             (= threading-mode "dedicated")
+                             ThreadingMode/DEDICATED
+                             (= threading-mode "shared-network")
+                             ThreadingMode/SHARED_NETWORK)
+        _ (println "Starting media driver with threading mode:" threading-mode)
+        ctx (cond-> (MediaDriver$Context.)
+              threading-mode (.threadingMode threading-mode))
         media-driver (MediaDriver/launch ctx)]
     (println "Launched the Media Driver. Blocking forever...")
-    (<!! (chan))))+    (<!! (chan))))


Improve readability.

Improve readability.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -48,7 +48,7 @@
             [onyx.static.default-vals :refer [arg-or-default]]
             [onyx.static.logging :as logger]
             [onyx.state.state-extensions :as state-extensions]
-            [onyx.static.util :refer [ms->ns deserializable-exception]]
+            [onyx.static.util :refer [ns->ms ms->ns deserializable-exception]]
             [onyx.types :refer [->Results ->MonitorEvent ->MonitorEventLatency]]
             [schema.core :as s]
             [taoensso.timbre :refer [debug info error warn trace fatal]])
@@ -601,12 +601,13 @@
               publishers)))

 (defn all-heartbeat-times [messenger]
-  (let [upstream (->> (mapcat vals (map pub/statuses (m/publishers messenger)))
-                      (map :heartbeat))
-        downstream (->> (sub/status-pubs (m/subscriber messenger))
-                        (vals)
-                        (map status-pub/get-heartbeat))]
-    (into upstream downstream)))
+  (let [downstream (->> (mapcat vals (map pub/statuses (m/publishers messenger)))
+                        (map :heartbeat))
+        time-convert-fn (fn [v] (- (System/nanoTime) v))
+        upstream (->> (sub/status-pubs (m/subscriber messenger))
+                      (vals)
+                      (map status-pub/get-heartbeat))]
+    (into downstream upstream)))

 (defn set-received-heartbeats! [messenger monitoring]
   (let [received-timer ^com.codahale.metrics.Timer (:since-received-heartbeat monitoring)
@@ -671,9 +672,9 @@
               _ (run! pub/poll-heartbeats! pubs)
               _ (run! pub/offer-heartbeat! pubs)
               opts (assoc (barrier-status-opts this) :event :heartbeat)]
-          (->> (sub/src-peers sub)
-               (run! (fn [peer-id]
-                       (sub/offer-barrier-status! sub peer-id opts))))
+          (run! (fn [peer-id]
+                  (sub/offer-barrier-status! sub peer-id opts))
+                (sub/src-peers sub))
           (.set last-heartbeat curr-time)
           (set-received-heartbeats! messenger monitoring)
           ;; check if downstream peers are still up


Unnecessary whitespace

Unnecessary whitespace

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -616,7 +616,6 @@
             pipeline (build-pipeline catalog-entry pipeline-data)
             pipeline-data (assoc pipeline-data :onyx.core/pipeline pipeline)

-
             restart-pred-fn (operation/resolve-restart-pred-fn catalog-entry)
             ex-f (fn [e] (handle-exception restart-pred-fn e restart-ch outbox-ch job-id))
             _ (while (and (first (alts!! [kill-ch task-kill-ch] :default true))


fix chats not getting saved to backend

fix chats not getting saved to backend

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -855,9 +855,11 @@

 (defmethod control-event :chat-submitted
   [browser-state message {:keys [chat-body]} state]
-  (-> state
+  (let [eid (-> state :entity-ids first)]
+    (-> state
       (handle-cmd-chat (chat-cmd chat-body) chat-body)
-      (assoc-in [:chat :entity-id] nil)))
+      (assoc-in [:chat :entity-id] eid)
+      (update-in [:entity-ids] disj eid))))

 (defmulti post-handle-cmd-chat (fn [state cmd]
                                  (utils/mlog "post-handling chat command:" cmd)
@@ -883,7 +885,7 @@
                                              :cust/uuid (get-in current-state [:cust :cust/uuid])
                                              ;; TODO: teach frontend to lookup cust/name from cust/uuid
                                              :chat/cust-name (get-in current-state [:cust :cust/name])
-                                             :db/id (get-in previous-state [:chat :entity-id])
+                                             :db/id (get-in current-state [:chat :entity-id])
                                              :session/uuid (:sente-id previous-state)
                                              :document/id (:document/id previous-state)
                                              :client/timestamp (js/Date.)


also switch on chat for mobile

also switch on chat for mobile

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -442,6 +442,7 @@
      (assoc-in state/overlay-info-opened-path false)
      (assoc-in state/aside-menu-opened-path true)
      (assoc-in [:camera :offset-x] (get-in state state/aside-width-path))
+     (assoc-in state/chat-mobile-opened-path true)
      (assoc-in [:chat :body] "@prcrsr ")))

 (defmethod post-control-event! :chat-link-clicked


Add simple test

Add simple test

--- test/clj/introspect/core_test.clj
+++ test/clj/introspect/core_test.clj
@@ -1,12 +1,13 @@
 (ns introspect.core-test
   (:require [clojure.test :refer :all]
             [introspect.core :refer :all]
-
             [introspect.helpers.simple-functions :as h1]))

 (deftest a-test
-  (introspect-namespace 'introspect.helpers.simple-functions)
-
   (h1/constant-return-value-fn 1 1)
   (h1/constant-return-value-fn "1" "1")
-  )
+
+  (is (= "(java.lang.Long -> java.lang.Long -> java.lang.Long)
+(java.lang.Long -> java.lang.String -> java.lang.String)\n"
+         (with-out-str
+           (t h1/constant-return-value-fn)))))


core.async: More on transducers.

core.async: More on transducers.

--- test/com/nomistech/clojure_the_language/core_async_mapping_etc_test.clj
+++ test/com/nomistech/clojure_the_language/core_async_mapping_etc_test.clj
@@ -71,7 +71,8 @@

 ;;;; Transducers

-;;;; #### A zero buffer size does not to the xform!!!
+;;;; #### A zero buffer size does not do the xform!!!
+;;;;      Must have a buffer. Zero gives no buffer I guess.

 (fact "My first transducer example "
   (let [c (a/chan 1 (map (partial * 100)))]
@@ -85,14 +86,22 @@
     (chan->seq c))
   => [0 2 4])

+
+;;;; #### Huh? Wrong order of composition??
+;;;; See http://clojure.org/transducers :
+;;;; - "Composition of the transformer runs right-to-left but builds a
+;;;;    transformation stack that runs left-to-right (filtering happens
+;;;;    before mapping in this example)."
+
 (fact "My third transducer example"
-  ;; #### Huh? Wrong order of composition??
-  ;; See http://clojure.org/transducers :
-  ;; - "Composition of the transformer runs right-to-left but builds a
-  ;;    transformation stack that runs left-to-right (filtering happens
-  ;;    before mapping in this example)."
   (let [c (a/chan 1 (comp (filter even?)
                           (map (partial * 100))))]
     (a/onto-chan c (range 5))
     (chan->seq c))
   => [0 200 400])
+
+(fact "My fourth transducer example"
+  (let [c (a/chan 1 (remove keyword?))]
+    (a/onto-chan c (mapcat (fn [x] [x :plop]) (range 5)))
+    (chan->seq c))
+  => [0 1 2 3 4])


Add a test for position

Add a test for position

--- test/useful/map_test.clj
+++ test/useful/map_test.clj
@@ -47,3 +47,7 @@
 (deftest test-index-by
   (is (= {true 3 false 4} (index-by odd? [1 3 4])))
   (is (= {1 2 3 4 5 6}    (index-by dec  [2 4 6]))))
+
+(deftest test-position
+  (is (= (position [1 3 5 3])
+         {1 0 3 1 5 2})))


fix a bunch of tests

fix a bunch of tests

Cur status:
Ran 4 tests containing 100 assertions.
10 failures, 2 errors.

texture stuff remains.


Changed buttons for Zoom-Move in lattice editor

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

--- src/conexp/graphics/draw.clj
+++ src/conexp/graphics/draw.clj
@@ -122,19 +122,18 @@
 (defn- toggle-zoom-move
   "Install zoom-move-toggler."
   [frame scn buttons]
-  (let [#^JButton zoom-button (make-button buttons "Zoom"),
-	#^JButton move-button (make-button buttons "Move"),
+  (let [#^JButton zoom-move (make-button buttons "Move"),
 	#^JLabel  zoom-info   (make-label buttons "1.0")]
-    (add-action-listener zoom-button (fn [evt]
-				       (.. scn getWindow (startInteraction (zoom-interaction scn)))
-				       (.setEnabled move-button true)
-				       (.setEnabled zoom-button false)))
-    (add-action-listener move-button (fn [evt]
-				       (.. scn getWindow (startInteraction (move-interaction scn)))
-				       (.setEnabled zoom-button true)
-				       (.setEnabled move-button false)))
-    (.setEnabled zoom-button true)
-    (.setEnabled move-button false)
+    (add-action-listener zoom-move
+			 (fn [evt]
+			   (do-swing
+			    (if (= "Move" (.getText zoom-move))
+			      (do
+				(.. scn getWindow (startInteraction (zoom-interaction scn)))
+				(.setText zoom-move "Zoom"))
+			      (do
+				(.. scn getWindow (startInteraction (move-interaction scn)))
+				(.setText zoom-move "Move"))))))
     (add-callback-for-hook scn :zoom-event
 			   (fn []
 			     (do-swing


(SERVER-548) Stop executing assertions from functions

Without this patch the approach to testing modified Puppet 3 request
headers is less than ideal because the assertions are wrapped in a
function and then executed at a distance from the test case.  This patch
addresses the problem by using a ring middleware to stash the munged
request in an Atom and then return that stashed, munged request to the
caller.  This allows the munged request to be tested directly rather
than at a distance.  Conceptually, this patch implements a tap into the
function pipeline sending the request to the master-handler.

--- test/unit/puppetlabs/services/legacy_routes/legacy_routes_core_test.clj
+++ test/unit/puppetlabs/services/legacy_routes/legacy_routes_core_test.clj
@@ -4,8 +4,7 @@
             [puppetlabs.services.legacy-routes.legacy-routes-core :refer :all]
             [puppetlabs.services.master.master-core :as master-core]
             [ring.mock.request :as mock]
-            [ring.util.codec :as ring-codec]
-            [clojure.string :as str]))
+            [ring.util.codec :as ring-codec]))

 (use-fixtures :once schema-test/validate-schemas)

@@ -34,7 +33,6 @@
     "pson, s, raw, foo" "pson, binary, foo"
     "s, pson, foo" "binary, pson, foo"))

-;
 (def accept-header-test-data
   "Nested map of request data.  The map keys represent URI paths, the request
   method, the example input, and the expected output.
@@ -51,33 +49,21 @@
                                              :put accept-header-s-pson-examples}
    })

-(defn assertion-wrapper
-  "ring middleware that asserts by passing the request as the first argument
-  to assertion"
-  [handler assertion]
-  (fn [req]
-    (assertion req)
-    (handler req)))
+(defn build-app
+  "Build a ring app with handler as the handler and the identity function as
+  the ca-handler"
+  [handler]
+  (build-ring-handler
+    handler master-mount master-api-version identity ca-mount ca-api-version))

-(defn validating-app
-  "Return a ring app with the results of build-ring-handler wrapped around an
-  assertion-wrapper middleware as the master-handler.  The identity function is
-  the ca-handler."
-  [assertion]
-  (let [handler (assertion-wrapper identity assertion)]
-    (build-ring-handler
-      handler master-mount master-api-version
-      identity ca-mount ca-api-version)))
-
-(defn test-munged-request
-  "Validate a request by threading it through the legacy-routes request handler
-  into an assertion-wrapper ring middleware."
-  [request assertion]
+(defn munged-request
+  "Return the request that would be sent to the master-handler after processing
+  by the legacy-routes handler."
+  [request]
   (let [mem (atom {:tested false})
-        wrapped-assertion #((swap! mem assoc :tested true) (assertion %))
-        response ((validating-app wrapped-assertion) request)]
-    (is (true? (:tested @mem)) (str "request not tested: " (pr-str request)))
-    response))
+        tapped-app (build-app #(swap! mem assoc :request %))]
+    (tapped-app request)
+    (:request @mem)))

 (deftest test-legacy-routes
   (let [app     (build-ring-handler
@@ -136,17 +122,13 @@
               [method examples] methods
               [example expected] examples
               :let [mockreq (mock/request method path)
-                    request (assoc-in mockreq accept-header example)]]
-        (test-munged-request request
-          (fn [munged-request] ; ring middleware
-            (let [actual (get-in munged-request accept-header)
-                  msg (str/join " "
-                        ["data:" path method example "=>" expected])]
-              (is (= expected actual) msg))))))
-    (testing (str "Content-Type: application/octet-stream "
-               "is added to file_bucket_file put requests")
-      (let [request (mock/request :put "/production/file_bucket_file/foo")]
-        (test-munged-request request
-          (fn [munged-request] ; ring middleware
-            (let [actual (get-in munged-request content-type-request-header)]
-              (is (= "application/octet-stream" actual)))))))))
+                    request (assoc-in mockreq accept-header example)
+                    subject (get-in (munged-request request) accept-header)]]
+        (is (= expected subject))))))
+
+(deftest test-v3-file-bucket-file-put
+  (testing (str "file_bucket_file put requests have application/octet-stream")
+    (let [request (mock/request :put "/production/file_bucket_file/foo")
+          munged-req (munged-request request)
+          content-type (get-in munged-req [:headers "content-type"])]
+      (is (= "application/octet-stream" content-type)))))


Test that against-background is only called once per fact

--- test/midje/ideas/t_background.clj
+++ test/midje/ideas/t_background.clj
@@ -136,4 +136,9 @@
 (facts "about safe expansion of weird forms"
   (map? {1 'do}) => truthy
   (first (second '(midje.semi-sweet.expect (midje.sweet.fact 1 => 2)))) => 'midje.sweet.fact
-  (set? #{1 'do}) => truthy)+  (set? #{1 'do}) => truthy)
+
+(let [around-facts-call-count (atom 0)]
+  (against-background [(around :facts (do (swap! around-facts-call-count inc) ?form))]
+    (fact "around-facts is only called once per fact"
+      @around-facts-call-count => 1)))


Fix install task --file option regression (fixes #96)

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -556,9 +556,10 @@
     (util/with-let [_ fileset]
       (let [jarfiles (or (and file [(io/file file)])
                          (->> (core/output-files fileset)
-                              (core/by-ext [".jar"])))]
+                              (core/by-ext [".jar"])
+                              (map core/tmpfile)))]
         (when-not (seq jarfiles) (throw (Exception. "can't find jar file")))
-        (doseq [jarfile (map core/tmpfile jarfiles)]
+        (doseq [jarfile jarfiles]
           (util/info "Installing %s...\n" (.getName jarfile))
           (pod/with-call-worker
             (boot.aether/install ~(core/get-env) ~(.getPath jarfile))))))))


Get scalar tensor shape

Get scalar tensor shape

--- test/tensorflow_clj/core_test.clj
+++ test/tensorflow_clj/core_test.clj
@@ -3,6 +3,7 @@
             [tensorflow-clj.core :refer :all]))

 (deftest scalar-tensor
-  (testing "Scalar tensor creation"
+  (testing "Scalar tensor"
     (let [t (org.tensorflow.Tensor/create 123.0)]
-      (is (= org.tensorflow.DataType/DOUBLE (.dataType t))))))
+      (is (= org.tensorflow.DataType/DOUBLE (.dataType t)))
+      (is (= [] (vec (.shape t)))))))


Some cleanups.

Some cleanups.

--- clojure/src/advent2016/day14.clj
+++ clojure/src/advent2016/day14.clj
@@ -5,28 +5,22 @@
 (def puzzle "cuanljph")

 (def triple (comp second (partial re-find #"([0-9a-f])\1{2}")))
-(defn quintuple? [^String digit ^String hash]
+(defn quintuple? [digit [_ hash]]
   (clojure.string/index-of hash (str digit digit digit digit digit)))

-(defn key? [stream ^String hash]
+(defn key? [hashes hash]
   (if-let [digit (triple hash)]
-    (some #(quintuple? digit %) (take 1000 stream))))
+    (some #(quintuple? digit %) (take 1000 hashes))))

-(defn hash-stream [f ^String salt]
-  (map (fn [n] (list n (f (str salt n)))) (range)))
+(defn iterated-hash [iterations salt]
+  (map (fn [n]
+         (list n (nth (iterate md5 (str salt n)) iterations)))
+       (range)))

-(defn key-stream [stream]
-  (filter (fn [[n hash]] (key? (drop (inc n) stream) hash)) stream))
+(defn solve [salt iterations]
+  (let [hashes (iterated-hash iterations salt)]
+    (filter (fn [[n hash]] (key? (drop (inc n) hashes) hash))
+            hashes)))

-(defn stretched-md5 [^String hash]
-  (nth (iterate md5 hash) 2017))
-
-(def solution1-key-stream (->> puzzle
-                               (hash-stream md5)
-                               key-stream))
-(def solution1 (take 64 solution1-key-stream))
-
-(def solution2-key-stream (->> puzzle
-                               (hash-stream stretched-md5)
-                               key-stream))
-(def solution2 (take 64 solution2-key-stream))
+(def solution1 (take 64 (solve puzzle 1)))
+(def solution2 (take 64 (solve puzzle 2017)))


Add data normalization with pmap

Add data normalization with pmap

--- src/cyanite_fetcher/core.clj
+++ src/cyanite_fetcher/core.clj
@@ -323,6 +323,26 @@
     (newline)
     ndata))

+(defn p-norm
+  "Normalization with pmap."
+  [data rollup to]
+  (println "Running normalization with pmap...")
+  (let [ndata
+        (time (doall (let [min-point  (:time (first data))
+                           max-point  (-> to (quot rollup) (* rollup))
+                           nil-points (->> (range min-point (inc max-point) rollup)
+                                           (pmap (fn [time] {time [{:time time}]}))
+                                           (reduce merge {}))
+                           by-path    (->> (group-by :path data)
+                                           (pmap (partial fill-in nil-points))
+                                           (reduce merge {}))]
+                       {:from min-point
+                        :to   max-point
+                        :step rollup
+                        :series by-path})))]
+    (newline)
+    ndata))
+
 ;;------------------------------------------------------------------------------
 ;; Benchmark
 ;;------------------------------------------------------------------------------
@@ -350,13 +370,15 @@
     (newline)
     (let [paths (es-get-paths eshost path tenant)
           data (c-get-data chost paths tenant rollup period from to)
-          fdata (flatter data (fn [data] (r/reduce into [] data)) "r/reduce")]
-      (flatter data (fn [data] (reduce into data)) "reduce")
-      (cleaner fdata (fn [data] (into [] (r/remove nil? data))) "r/remove")
-      (cleaner fdata (fn [data] (remove nil? data))  "remove")
+          ;;fdata (flatter data (fn [data] (r/reduce into [] data)) "r/reduce")
+          ]
+      ;;(flatter data (fn [data] (reduce into data)) "reduce")
+      ;;(cleaner fdata (fn [data] (into [] (r/remove nil? data))) "r/remove")
+      ;;(cleaner fdata (fn [data] (remove nil? data))  "remove")
       (let [fcdata (r-flatter-cleaner data)]
         (norm fcdata rollup to)
-        (r-norm fcdata rollup to))))
+        (r-norm fcdata rollup to)
+        (p-norm fcdata rollup to))))
   (println "Finish time:" (tl/format-local-time (tl/local-now) :rfc822)))

 ;;------------------------------------------------------------------------------


Functions to read port number

Functions to read port number

--- src/emender_jenkins/core.clj
+++ src/emender_jenkins/core.clj
@@ -28,6 +28,22 @@
         (start-server-on-openshift openshift-port openshift-ip)
         (start-server-on-regular-machine port)))

+(defn get-and-check-port
+    "Accepts port number represented by string and throws AssertionError
+     if port number is outside defined range."
+    [port]
+    (let [port-number (. Integer parseInt port)]
+        (assert (> port-number 0))
+        (assert (< port-number 65536))
+        port))
+
+(defn get-port
+    "Returns specified port or default port if none is specified on the command line."
+    [specified-port]
+    (if (or (not specified-port) (not (string? specified-port)) (empty? specified-port))
+        config/default-port
+        (get-and-check-port specified-port)))
+
 (defn -main
     "Entry point to the titan server."
     [& args]


Create an app to be used as execution context for event processing.

--- src/fm/simrunner/gui/app.clj
+++ src/fm/simrunner/gui/app.clj
@@ -7,38 +7,43 @@
   (:require
     [fm.simrunner.gui (core :as gui)
                       (view :as view)
-                      (wiring :as wiring)])
-  (:import
-    (java.awt BorderLayout)
-    (javax.swing SwingUtilities
-                 JOptionPane)))
+                      (wiring :as wiring)]))

 (defmulti on-action {:private true} (fn [action & _] action))

-(defmethod on-action :open-config [_ model & args]
-  (println (format "open-config{model: %s args: %s}" model args))
+(defmethod on-action :open-config [_ app & args]
+  (println (format "open-config{args: %s}" args))
   (gui/choose-file (-> args first :widget) :title "Open Config"))

-(defmethod on-action :default [action model & args]
-  (println (format "on-action{action: %s model: %s args: %s}"
-                   action model args)))
+(defmethod on-action :default [action app & args]
+  (println (format "on-action{action: %s args: %s}" action args)))

 (defmulti on-event {:private true} (fn [_ event-id & _] event-id))

-(defmethod on-event :action-performed [model _ & args]
-  (on-action (-> args first meta :action) model args))
+(defmethod on-event :action-performed [app _ & args]
+  (on-action (-> args first meta :action) app args))

-(defmethod on-event :default [model event-id & args]
-  (println (format "on-event{model: %s id: %s args: %s}" model event-id args)))
+(defmethod on-event :default [app event-id & args]
+  (println (format "on-event{id: %s args: %s}" event-id args)))
+
+(defn- app [config view]
+  {:config config
+   :worker (agent nil)
+   :state  (atom {:ui {:view      view
+                       :updating? false}})})
+
+(defn- event-handler [app]
+  (fn [& args]
+    (when-not (-> app :state deref :ui :updating?)
+      (apply on-event app args))))

 (defn start [config]
   @(gui/gui-do
     (let [frame (view/simrunner-frame)
           view  (-> frame :contents :simrunner-view)
           frame (:widget frame)
-          model (ref {:app-config config
-                      :worker     (agent nil)})]
-      (wiring/wire-up view (partial on-event model))
+          app   (app config view)]
+      (wiring/wire-up view (event-handler app))
       (.setTitle frame "SimRunner (c) 2014 DEINC")
       (.show frame))))


New problem added

New problem added


Retag "Analyze a Tic-Tac-Toe board"

Retag "Analyze a Tic-Tac-Toe board"

--- src/foreclojure/data_set.clj
+++ src/foreclojure/data_set.clj
@@ -771,7 +771,7 @@
             :title "Power Set"
             :times-solved 0
             :description "A power set is the set of all subsets of a given set. Given a list, produce a set of sublists while preserving the order of elements."
-            :tags ["medium" "seqs"]
+            :tags ["hard" "seqs"]
             :tests ["(= (__ '(1 :a)) '#{(1 :a) (:a) () (1)})"
                     "(= (__ '()) '#{()})"
                     "(= (__ '(1 2 3)) '#{() (1) (2) (3) (1 2) (1 3) (2 3) (1 2 3)})"


Fix for 'Times Solved' on /problems

Fix for 'Times Solved' on /problems

It turns out (keyword 1) is nil; you have to use (keyword (str 1)).

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -94,7 +94,8 @@
                  code)))

 (defn record-golf-score! [user-id problem-id score]
-  (when-let [{user-id :_id {old-score (keyword problem-id)} :scores :as user}
+  (when-let [{{old-score (keyword (str problem-id))} :scores
+              user-id :_id :as user}
              (from-mongo
               (fetch-one :users
                          :where {:_id user-id}))]


handle verbs with [infl=infinitive]

handle verbs with [infl=infinitive]

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -34,11 +34,17 @@
    true
    ""))

+(defn exception [error-string]
+  #?(:clj
+     (throw (Exception. (str ": " error-string))))
+  #?(:cljs
+     (throw (js/Error. error-string))))
+
 (defn get-string [word & {:keys [show-notes]
                           :or {show-notes true}}]
   (log/debug (if (map? word) (str "get-string: " (strip-refs word))))
   (cond
-
+
    (ref? word)
    (get-string @word :show-notes show-notes)

@@ -51,6 +57,11 @@
         (nil? (:english word))
         (nil? (:english word)))
    ".."
+
+    (= (get-in word '(:infl)) :infinitive)
+    (if (string? (get-in word '(:english)))
+      (str "to " (get-in word '(:english)))
+      (exception (str "don't know how to find infinitive for word: " word)))

    ;; "to do [past]" + "well" => "did well"
    (and (= (get-in word '(:cat)) :verb)


Added some additional trace level logging.

--- src/blutwurst/tuple_formatter.clj
+++ src/blutwurst/tuple_formatter.clj
@@ -1,5 +1,6 @@
 (ns blutwurst.tuple-formatter
-    (:require [clojure.data.csv :as csv]))
+    (:require [clojure.data.csv :as csv]
+              [taoensso.timbre :as timbre :refer [trace]]))

 ; TODO: handle file output
 (defn- csv-formatter [spec rows]
@@ -11,6 +12,7 @@
   })

 (defn format-rows [spec rows]
+ (trace rows)
   (let [formatter ((:format spec) formatters)]
     (formatter spec rows)
     ))


single firefox instance for thread scrape, fixed bulb scrape timeout

--- src/bonews_rest/scraper/bulbs.clj
+++ src/bonews_rest/scraper/bulbs.clj
@@ -5,23 +5,15 @@

 (def link-href [[:a (html/attr? :href)]])

-; (defn get-page-source
-;   [reply-url]
-;   (web/set-driver! {:browser :firefox} reply-url)
-;   (web/to reply-url)
-;   (web/click "input.bo_knows_bulbs_view_votes")
-;   (web/wait-until #(web/visible? "div.bo_knows_bulbs_voters") 9000 1000)
-;   (let [reply-page (utils/parse-page-source (web/page-source))]
-;     (web/close)
-;     reply-page
-;   ))
+(defn get-bulbs-clickable?
+  []
+  (web/click (web/find-element {:css "input.bo_knows_bulbs_view_votes"}))
+  (web/visible? "div.bo_knows_bulbs_voters"))

 (defn get-page-source
   [reply-url]
   (web/to reply-url)
-  (Thread/sleep 3000)
-  (web/click "input.bo_knows_bulbs_view_votes")
-  (web/wait-until #(web/visible? "div.bo_knows_bulbs_voters") 9000 1000)
+  (web/wait-until #(get-bulbs-clickable?))
   (utils/parse-page-source (web/page-source)))

 (defn get-username
@@ -50,11 +42,15 @@
 (defn get-upvotes-list
   [reply-page]
   (-> reply-page
+      (html/select [:div.bo_knows_bulbs_voters html/first-child])
+      first
       (html/select [:ul.bo_knows_bulbs_up])))

 (defn get-downvotes-list
   [reply-page]
   (-> reply-page
+      (html/select [:div.bo_knows_bulbs_voters html/first-child])
+      first
       (html/select [:ul.bo_knows_bulbs_down])))

 (defn get-vote-data


Ste/Chris - adding black list

Ste/Chris - adding black list

--- src/build_monitor_clj/reducer.clj
+++ src/build_monitor_clj/reducer.clj
@@ -21,4 +21,5 @@

 (defn show-selected-projects [projects]
   (->> (aggregate projects)
-       (include-whitelisted-projects)))+       (include-whitelisted-projects)
+       (filter-blacklisted-projects)))


add construct function

add construct function

--- src/ca_recipe/components/feed.clj
+++ src/ca_recipe/components/feed.clj
@@ -11,3 +11,8 @@
   (stop [component]
     (reset! (:status component) :stopoed)
     component))
+
+
+(defn new-feed [auth msg-chan response-chan]
+  (->Feed auth (atom :init) msg-chan response-chan))
+


Add tests for the new arity of catch.

Add tests for the new arity of catch.

--- test/beicon/tests/core_tests.cljs
+++ test/beicon/tests/core_tests.cljs
@@ -241,7 +241,7 @@
       (drain! s3 #(t/is (= % [[1 0] [2 0] [3 0]])))
       (s/on-end s3 done))))

-(t/deftest observable-catch
+(t/deftest observable-catch-1
   (t/async done
     (let [s1 (s/throw (ex-info "error" {:foo :bar}))
           s2 (s/catch (fn [error]
@@ -250,6 +250,26 @@
       (t/is (s/observable? s2))
       (drain! s2 #(t/is (= % [{:foo :bar}])))
       (s/on-end s2 done))))
+
+(t/deftest observable-catch-2
+  (t/async done
+    (let [type1? #(= 1 (:type (ex-data %)))
+          s1 (->> (s/throw (ex-info "error" {:type 1}))
+                  (s/catch type1? #(s/once (ex-data %))))]
+      (t/is (s/observable? s1))
+      (drain! s1 #(t/is (= % [{:type 1}])))
+      (s/on-end s1 done))))
+
+(t/deftest observable-catch-3
+  (t/async done
+    (let [type1? #(= 1 (:type (ex-data %)))
+          type2? #(= 2 (:type (ex-data %)))
+          s1 (->> (s/throw (ex-info "error" {:type 1}))
+                  (s/catch type2? #(s/once (ex-data %)))
+                  (s/catch type1? #(s/once (ex-data %))))]
+      (t/is (s/observable? s1))
+      (drain! s1 #(t/is (= % [{:type 1}])))
+      (s/on-end s1 done))))

 (t/deftest observable-to-atom
   (t/async done


Fix inbox button highlight when navigating via sidebar

--- src/braid/core/client/ui/views/sidebar.cljs
+++ src/braid/core/client/ui/views/sidebar.cljs
@@ -136,8 +136,7 @@
                       (when (= group (@drag-state :grp))
                         {:opacity 0.2}))
              :title (group :name)
-             :href (routes/page-path {:group-id (group :id)
-                                      :page-id "inbox"})
+             :href (routes/inbox-page-path {:group-id (group :id)})
              :on-mouse-down (partial drag-start group)
              :on-mouse-up (partial drag-end group)
              :on-mouse-move (partial drag-move group)}


account settings grid trim

account settings grid trim

--- src/cljs/swarmpit/component/api_access.cljs
+++ src/cljs/swarmpit/component/api_access.cljs
@@ -101,8 +101,8 @@
                {:variant  "contained"
                 :disabled false
                 :onClick  generate-handler
-                :color    "primary"}
-               (case state :none "Generate" "Regenerate"))
+                :color    "primary"
+                (case state :none "Generate" "Regenerate")})
              (comp/button
                {:variant  "outlined"
                 :disabled (= :none state)


4clojure:: one the way to solve the universal-computation-engine in clojure

--- src/clojure_learning/4clojure-exercises.clj
+++ src/clojure_learning/4clojure-exercises.clj
@@ -3670,3 +3670,56 @@
 (every? (partial = (first coll)) (rest coll)) ;; true

 ;; TODO: refactor the previous find-intervals function
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Universal Computation Engine
+;; Difficulty:	Medium
+;; Topics:	functions
+;; Special Restrictions: [eval] + [resolve]
+;; Given a mathematical formula in prefix notation, return a function that calculates the value of the formula.
+;; The formula can contain nested calculations using the four basic mathematical operators,
+;; numeric constants, and symbols representing variables.
+;; The returned function has to accept a single parameter containing the map of variable names to their values.
+;; (= 2 ((__ '(/ a b))
+;;       '{b 8 a 16}))
+
+;; ((func '(* (+ 2 a)
+;;           (- 10 b)))
+;;    '{a 2 b 3})
+;; -> 28
+(defn calc [forms]
+  (fn [bound-map]
+    (let [ops {'/ "/" '* "*" '+ "+" '- "-"}]
+    (letfn [(resolve-one
+              [bound-map [head & tail]]
+                 (when-not (nil? head)
+                   (cons (if (symbol? head)
+                           (if-let [func (get ops head)]
+                             (read-string func)
+                             (get bound-map head))
+                           head)
+                         (resolve-one bound-map tail))))]
+      (resolve-one bound-map forms)
+;;       (map #(resolve-one bound-map %) (list forms))
+      ))))
+
+(eval ((calc '(/ a b)) '{a 16 b 8}))
+((calc '(/ a b)) '{a 8 b 2}) ;; (/ 8 2)
+((calc '(* (+ a 2) (- 10 b))) '{a 16 b 8})
+
+(cons (first '(/ 2 3)) (cons 3 (cons 3 '()))) ;; (/ 3 3)
+(symbol? (first '(/ 2 3)))  ;; true
+(fn? (first '(/ 2 3)))   ;; false
+(symbol? (first '(a b))) ;; true
+
+(apply (resolve (first '(+ 1 1))) [8 3]) ;; 11
+(apply (ns-resolve *ns* (first '(+ 1 1))) [8 3]) ;; 11
+(symbol? (first '(/ 2))) ;; true
+(apply (ns-resolve *ns* (first '(/ 1 1))) [8 2])
+(fn? (ns-resolve *ns* (first '(/ 1 1))))
+(ns-resolve *ns* (first '(/ 1 1)))
+(symbol? (ns-resolve *ns* (first '(/ 1 1))))
+(fn? clojure.core//)
+(source eval)
+(list '(/ 1 2))
+(clojure.string/replace symbol? "avc" "as")


libssh2_version should always be given a parameter.

--- test/clj_libssh2/test_libssh2.clj
+++ test/clj_libssh2/test_libssh2.clj
@@ -7,4 +7,4 @@

 (deftest check-libssh2-version-is-ok
   "This shoudln't change by surprise!"
-  (is (= "1.6.0" (libssh2/version))))
+  (is (= "1.6.0" (libssh2/version 0))))


* 4clojure: implementing the core [map] func

--- src/clojure_learning/4clojure-exercises.clj
+++ src/clojure_learning/4clojure-exercises.clj
@@ -1161,3 +1161,27 @@
 ;; but as we know we can use: m k -> to get the corresponding value, idiomatic clojurist way :)
 ;; yes the add-to-map func is just for readability -> clean code ;)

+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Easy
+;; Reimplement [map]
+;; Map is one of the core elements of a functional programming language.
+;; Given a function f and an input sequence s,
+;; RETURN A LAZY SEQUENCE of (f x) for each element x in s.
+(defn mmap
+  [func coll]
+  (lazy-seq
+    (when-let [head (first coll)]
+      (cons (func head) (mmap func (rest coll)) ))))
+
+;; neat :)
+(cons 2 (cons 3 (cons 4 (lazy-seq nil)))) ; (2 3 4)
+(lazy-seq nil) ; ()
+
+;; Note1: recursion with lists: go till end & start from the end -> use [cons]
+;; to build the list in order recursively.
+;; While with vectors -> start recursively from beginning and push on top of the stack.
+;; Note2: any lazy-sequences in clojure, must be prepended with lazy-seq
+
+;; demo:
+(mmap inc [1 2 3]) ; (2 3 4)


Add reset button

Add reset button

--- src/cljs/battle_console/game.cljs
+++ src/cljs/battle_console/game.cljs
@@ -114,11 +114,19 @@
   []
   (-> (by-id "newAction") (.-value)))

+(defn- reset-actions
+  "Reset the current actions being applied"
+  []
+  (state/set-state :current-actions []))
+
 (defn- action-added
   "Added action"
   [data]
   (let [actions (or (state/get-state :current-actions) [])
-        current-action (state/get-state :processing-action)]
+        current-action (state/get-state :processing-action)
+        new-actions (conj actions current-action)]
+    (state/set-state :current-actions new-actions)
+    (println new-actions)
     (state/set-state :processing-action nil))
   (println data))

@@ -148,7 +156,8 @@
   (dom/div #js {:className (str "form-group ")}
     (dom/label #js {:for "newAction" :className "control-label"} "Action:")
     (dom/input #js {:type "text" :id "newAction" :className "form-control"})
-    (dom/button #js {:id "addActionButton" :onClick add-action :className "btn btn-default" :disabled (add-action-disabled state)} "Add")))
+    (dom/button #js {:id "resetActionButton" :onClick reset-actions :className "btn btn-default"} "Reset")
+    (dom/button #js {:id "addActionButton" :onClick add-action :className "btn btn-info" :disabled (add-action-disabled state)} "Add")))

 (defn- render-game
   "Renders the index page"


test insert-select-delete

test insert-select-delete

--- test/er_cassandra/record_test.clj
+++ test/er_cassandra/record_test.clj
@@ -303,15 +303,23 @@
             10
             {:blah true})))))

-(deftest select-test
-  (let [_ (tu/create-table :select_test "(id timeuuid primary key)")
+(deftest insert-select-delete-test
+  (let [_ (tu/create-table :stmt_test "(id timeuuid primary key)")

         t (uuid/v1)
         ;; insert with record layer to trigger truncates on session close
         _ @(r/insert
             tu/*session*
-            :select_test
+            :stmt_test
             {:id t})]
     (testing "simple select-one"
       (is (= {:id t}
-             @(r/select-one tu/*session* :select_test :id t))))))
+             @(r/select-one tu/*session* :stmt_test :id t))))
+    (testing "delete"
+      (let [_ @(r/delete
+                tu/*session*
+                :stmt_test
+                :id
+                t)]
+        (is (= nil
+               @(r/select-one tu/*session* :stmt_test :id t)))))))


Only show tabs when there is more than one editor

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -107,7 +107,8 @@
                 (when (= (.getEventType e) HyperlinkEvent$EventType/ACTIVATED)
                   (binding [*reorder-tabs?* false]
                     (ui/update-project-tree! (.getDescription e))))))
-    (shortcuts/toggle-hint! @tabs @shortcuts/is-down?)))
+    (when (> (count @editors) 0)
+      (shortcuts/toggle-hint! @tabs @shortcuts/is-down?))))

 ; button bar actions


Update buttons on key released

Update buttons on key released

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -611,6 +611,9 @@
       (some->> completer (completions/install-completer! text-area))
       ; add watchers
       (add-watchers! path text-area)
+      ; initialize parinfer
+      (init-parinfer! text-area extension edit-history true)
+      (update-buttons! editor-pane text-area)
       ; enable/disable buttons while typing
       (.addDocumentListener (.getDocument text-area)
         (reify DocumentListener
@@ -620,12 +623,8 @@
             (update-buttons! editor-pane text-area))
           (removeUpdate [this e]
             (update-buttons! editor-pane text-area))))
-      (add-watch edit-history :update-edit-history
-        (fn [_ _ _ _]
-          (update-buttons! editor-pane text-area)))
-      ; initialize parinfer
-      (init-parinfer! text-area extension edit-history true)
-      (update-buttons! editor-pane text-area)
+      (s/listen text-area :key-released
+        (fn [e] (update-buttons! editor-pane text-area)))
       ; return a map describing the editor
       {:view editor-pane
        :text-area text-area


Only update publish date if something has changed

--- src/infoq_podcast/server.clj
+++ src/infoq_podcast/server.clj
@@ -33,7 +33,8 @@
                                        "development"))
                  (rss/image (base-url "/styles/i/logo-big.jpg") "InfoQ" (base-url))
                  (rss/language "en-US")
-                 (rss/generator "InfoQ-Feed-Generator/1.0")]
+                 (rss/generator "InfoQ-Feed-Generator/1.0")
+                 (rss/pub-date (:date (first items)))]
         extensions [:atom :itunes :feedburner :simple-chapters :content :history]
         feed (rss/feed channel items extensions)]
     feed))


CMR-1810: A minor refactoring.

CMR-1810: A minor refactoring.

--- virtual-product-app/src/cmr/virtual_product/services/virtual_product_service.clj
+++ virtual-product-app/src/cmr/virtual_product/services/virtual_product_service.clj
@@ -270,11 +270,11 @@

 (defn- virtual-entries->source-entries
   "Translate the virtual entries to the corresponding source entries."
-  [context entries]
+  [context virtual-entries]
   (apply merge
-    (let [entries-by-src-entry-title (group-by get-provider-id-src-entry-title entries)]
-      (for [[[provider-id src-entry-title] virtual-entries] entries-by-src-entry-title]
-        (let [virt-to-src-gran-ur-map (compute-source-granule-urs provider-id virtual-entries)
+    (let [entries-by-src-entry-title (group-by get-provider-id-src-entry-title virtual-entries)]
+      (for [[[provider-id src-entry-title] virt-entries] entries-by-src-entry-title]
+        (let [virt-to-src-gran-ur-map (compute-source-granule-urs provider-id virt-entries)
               src-entries (create-source-entries
                             context provider-id src-entry-title (vals virt-to-src-gran-ur-map))]
               (map-virt-gran-ur-to-src-entry provider-id src-entries virt-to-src-gran-ur-map))))))