A ridiculous proxy macro which delegates calls to methods which have not been explicitly implemented to a specified object.

delegating-proxy.clj

;;; Written when pondering
;;; http://stackoverflow.com/questions/9086926/create-a-proxy-for-an-specific-instance-of-an-object-in-clojure

(defmacro delegating-proxy [o class-and-ifaces ctor-args & impls]
  (let [oname (gensym)]
    (letfn [(delegating-impls [^java.lang.reflect.Method ms]
              (let [mname (symbol (.getName ^java.lang.reflect.Method (first ms)))
                    arity-groups (partition-by #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)
                    max-arity (max-key #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)]
                `(~mname
                  ~@(remove
                     nil?
                     (map (fn [agroup]
                            (let [param-types (.getParameterTypes ^java.lang.reflect.Method (first agroup))
                                  vararg? (and (seq param-types) (or (.isArray ^Class (last param-types)) (<= 20 (count param-types))))
                                  arity  ((if vararg? dec identity) (count param-types))
                                  params (vec (repeatedly arity gensym))
                                  params (if vararg? (conj params '& (gensym)) params)]
                              (when-not (and vararg? (not= arity max-arity))
                                (list params `(. ~oname (~mname ~@params))))))
                          arity-groups)))))
            (combine-impls [eimpls dimpls]
              (map (fn [e d]
                     (let [e (if (vector? (second e))
                               (list (first e) (next e))
                               e)]
                       (list* (first e) (concat (next e) (next d)))))
                   eimpls
                   dimpls))]
      (let [klass   (resolve (first class-and-ifaces))
            methods (->> class-and-ifaces
                         (map resolve)
                         (mapcat #(.getDeclaredMethods ^Class %)))
            eimpl-specs (set (map (juxt first (comp count second)) impls))
            rm-fn   (fn rm-fn [^java.lang.reflect.Method m]
                      (contains? eimpl-specs [(symbol (.getName m)) (count (.getParameterTypes m))]))
            dimpls  (->> methods
                         (remove rm-fn)
                         (remove #(let [mods (.getModifiers ^java.lang.reflect.Method %)]
                                    (or (java.lang.reflect.Modifier/isPrivate mods)
                                        (java.lang.reflect.Modifier/isProtected mods))))
                         (sort-by #(.getName ^java.lang.reflect.Method %))
                         (partition-by #(.getName ^java.lang.reflect.Method %))
                         (map delegating-impls))
            dimpl-names (set (map first dimpls))
            eimpl-names (set (map first eimpl-specs))
            {eonly false eboth true} (group-by (comp boolean dimpl-names first) impls)
            {donly false dboth true} (group-by (comp boolean eimpl-names first) dimpls)
            all-impls (concat eonly donly (combine-impls eboth dboth))]
        `(let [~oname ~o]
           (proxy ~class-and-ifaces ~ctor-args
             ~@all-impls))))))

(comment

  ((delegating-proxy (fn [& args] :foo) [clojure.lang.IFn] [] (invoke [x] :bar)) 1)
  ; => :bar

  ((delegating-proxy (fn [& args] :foo) [clojure.lang.IFn] [] (invoke [x] :bar)) 1 2)
  ; => :foo

  )

;;; a version delegating all methods, for use with update-proxy
(defmacro delegating-proxy [o class-and-ifaces ctor-args]
  (let [oname (gensym)
        impls (->> class-and-ifaces
                   (map resolve)
                   (mapcat #(.getDeclaredMethods ^Class %))
                   (group-by #(.getName ^java.lang.reflect.Method %))
                   (vals)
                   (map (fn delegating-impls [^java.lang.reflect.Method ms]
                          (let [mname (symbol (.getName ^java.lang.reflect.Method (first ms)))
                                arity-groups (partition-by #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)
                                max-arity (max-key #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)]
                            `(~mname
                              ~@(remove
                                 nil?
                                 (map (fn [agroup]
                                        (let [param-types (.getParameterTypes ^java.lang.reflect.Method (first agroup))
                                              vararg? (and (seq param-types) (or (.isArray ^Class (last param-types)) (<= 20 (count param-types))))
                                              arity  ((if vararg? dec identity) (count param-types))
                                              params (vec (repeatedly arity gensym))
                                              params (if vararg? (conj params '& (gensym)) params)]
                                          (when-not (and vararg? (not= arity max-arity))
                                            (list params `(. ~oname (~mname ~@params))))))
                                      arity-groups)))))))]
    `(let [~oname ~o]
       (proxy ~class-and-ifaces ~ctor-args ~@impls))))

(comment

  (def p (delegating-proxy (fn [& args] :foo) [clojure.lang.IFn] []))
  ; => #'user/p
  (update-proxy p {"applyTo" (fn [& args] :bar)})
  ; => #<Object$IFn$4c646ebb user.proxy$java.lang.Object$IFn$4c646ebb@28ee1c42>
  (.invoke p 1)
  ; Reflection warning, NO_SOURCE_FILE:1 - call to invoke can't be resolved.
  ; => :foo
  (.applyTo p (seq [1]))
  ; Reflection warning, NO_SOURCE_FILE:1 - call to applyTo can't be resolved.
  ; => :bar

  )