binding.clj

(ns hoplon.binding
  (:refer-clojure :exclude [binding bound-fn])
  (:require [clojure.core :as clj]
            [cljs.analyzer :as a]
            [cljs.compiler :as c]))

(defmethod a/error-message ::export
  [warning-type info]
  (str (:name info) " not declared ^:export"))

(defn- confirm-export [env var]
  (when-not (:export var)
    (clj/binding [a/*cljs-warnings* (assoc a/*cljs-warnings* ::export true)]
      (a/warning ::export env var))))

(defmacro binding
  "Like clojure.core/binding, but can be used with bound-fn. The bindings
  should not be declared ^:dynamic, they must be declared ^:export instead."
  [bindings & body]
  (let [cljs-env  (assoc &env :ns (a/get-namespace a/*cljs-ns*))
        val-exprs (take-nth 2 (rest bindings))
        cljs-vars (->> (take-nth 2 bindings)
                       (map (partial a/resolve-existing-var cljs-env)))
        gensyms   (take (count cljs-vars) (repeatedly gensym))
        js-names  (map (comp str c/munge :name) cljs-vars)]
    (doseq [v cljs-vars] (confirm-export cljs-env v))
    `(let [~@(interleave gensyms val-exprs)]
       (hoplon.binding/push-thread-bindings ~(zipmap js-names gensyms))
       (try ~@body (finally (hoplon.binding/pop-thread-bindings))))))

(defmacro bound-fn
  "Creates a function, capturing the dynamic bindings in place. When the
  function is applied the saved bindings are set before evaluating the body
  and restored after. See clojure.core/bound-fn."
  [args & body]
  `(hoplon.binding/bound-fn* (fn [~@args] ~@body)))

binding.cljs

(ns hoplon.binding
  (:refer-clojure :exclude [binding])
  (:require-macros [hoplon.binding :as b]))

(def ^:export tmp    "Temporary variable for eval." nil)
(def thread-bindings "Stack of binding maps."       (atom []))
(def global-bindings "Map of initial var bindings." (atom {}))

(defn push-thread-bindings
  "Given a map with munged js variable names (as strings) for keys and the
  binding values as values, sets the variables to their new values and adds
  the binding map to the thread-bindings stack. If there are aren't yet any
  bindings for a variable its current value is stored in the global-bindings
  map so it can be restored later."
  [binding-map]
  (let [current (apply merge @thread-bindings)]
    (swap! thread-bindings conj binding-map)
    (doseq [[k v] binding-map]
      (when-not (contains? current k)
        (swap! global-bindings assoc k (js* "eval(~{})" k)))
      (set! hoplon.binding.tmp v)
      (js* "eval(~{})" (str k " = hoplon.binding.tmp" )))))

(defn pop-thread-bindings
  "Pops the topmost binding map from thread-bindings stack and restores the
  variables to their previous saved states."
  []
  (let [popped  (peek @thread-bindings)
        current (apply merge (swap! thread-bindings pop))]
    (doseq [k (keys popped)]
      (set! hoplon.binding.tmp (get current k (get @global-bindings k)))
      (js* "eval(~{})" (str k " = hoplon.binding.tmp" )))))

(defn bound-fn*
  "Given a function f, returns a new function capturing the current bindings
  in its closure. When the returned function is invoked the saved bindings
  are pushed and set, f is applied to the arguments, and bindings are restored
  to their previous values."
  [f]
  (let [binding-map (apply merge @thread-bindings)]
    (fn [& args]
      (push-thread-bindings binding-map)
      (try (apply f args) (finally (pop-thread-bindings))))))

Use case:

(binding [*state* (cell 100)]
  (div
    (button
      :click (bound-fn [_] (swap! *state* inc))
      (cell= (str *state* " clicks so far...")))))