diff --git a/src/cider/nrepl.clj b/src/cider/nrepl.clj index 2083b06c3..2e545be56 100644 --- a/src/cider/nrepl.clj +++ b/src/cider/nrepl.clj @@ -1,5 +1,6 @@ (ns cider.nrepl (:require [clojure.tools.nrepl.server :as nrepl-server] + [cider.nrepl.print-method] [cider.nrepl.middleware.apropos] [cider.nrepl.middleware.classpath] [cider.nrepl.middleware.complete] diff --git a/src/cider/nrepl/middleware/out.clj b/src/cider/nrepl/middleware/out.clj index 89d007731..de2e727ea 100644 --- a/src/cider/nrepl/middleware/out.clj +++ b/src/cider/nrepl/middleware/out.clj @@ -9,6 +9,7 @@ guarantee that the channel that sent the clone message will properly handle output replies." (:require [cider.nrepl.middleware.util.cljs :as cljs] + [clojure.string :as s] [clojure.tools.nrepl.middleware :refer [set-descriptor!]] [clojure.tools.nrepl.middleware.interruptible-eval :as ie] [clojure.tools.nrepl.middleware.session :as session]) diff --git a/src/cider/nrepl/print_method.clj b/src/cider/nrepl/print_method.clj new file mode 100644 index 000000000..0c39d940d --- /dev/null +++ b/src/cider/nrepl/print_method.clj @@ -0,0 +1,62 @@ +(ns cider.nrepl.print-method + (:require [clojure.string :as s]) + (:import [clojure.lang AFunction MultiFn] + java.io.Writer)) + +;; Extending `print-method` defined in clojure.core, to provide +;; prettier versions of some objects. This applies to anything that +;; calls `print-method`, which includes return values, `pr`, `print` +;; and the likes. + +(def ^:dynamic *pretty-objects* + "If true, cider prettifies some object descriptions. + For instance, instead of printing functions as + #object[clojure.core$_PLUS_ 0x4e648e99 \"clojure.core$_PLUS_@4e648e99\"] + they are printed as + #function[clojure.core/+] + + To disable this feature, do + (alter-var-root #'cider.nrepl.print-method/*pretty-objects* not)" + true) + +(defmacro def-print-method [dispatch-val arg & strings] + `(defmethod print-method ~dispatch-val [~arg ~'^Writer w] + (if *pretty-objects* + (do ~@(map #(list '.write 'w %) strings)) + (#'clojure.core/print-object ~arg ~'w)))) + +;;; Function objects +;; Ex: #function[cider.nrepl.print-method/multifn-name] +(def-print-method AFunction c + "#function[" + (-> (.getName (class c)) + (s/replace-first "$" "/") + (s/replace "_QMARK_" "?") + (s/replace "_PLUS_" "+") + (s/replace "_BANG_" "!") + (s/replace "_EQ_" "=") + (s/replace "_SLASH_" "/") + (s/replace "_STAR_" "*") + (s/replace "_" "-")) + "]") + +;;; Multimethods +;; Ex: #multifn[print-method 0x3f0cd5b4] +(defn multifn-name [^MultiFn mfn] + (let [field (.getDeclaredField MultiFn "name") + private (not (.isAccessible field))] + (when private + (.setAccessible field true)) + (let [name (.get field mfn)] + (when private + (.setAccessible field false)) + name))) + +(def-print-method MultiFn c + "#multifn[" + (try (multifn-name c) + (catch SecurityException _ + (class c))) + ;; MultiFn names are not unique so we keep the identity HashCode to + ;; make sure it's unique. + (format " 0x%x]" (System/identityHashCode c))) diff --git a/test/clj/cider/nrepl/print_method_test.clj b/test/clj/cider/nrepl/print_method_test.clj new file mode 100644 index 000000000..ed2ada0cd --- /dev/null +++ b/test/clj/cider/nrepl/print_method_test.clj @@ -0,0 +1,24 @@ +(ns cider.nrepl.print-method-test + (:require [cider.nrepl.print-method :refer :all] + [clojure.test :refer :all]) + (:import java.util.regex.Pattern)) + +(defn dummy-fn [o]) + +(deftest print-functions + (are [f s] (= (pr-str f) s) + print-functions "#function[cider.nrepl.print-method-test/print-functions]" + dummy-fn "#function[cider.nrepl.print-method-test/dummy-fn]" + multifn-name "#function[cider.nrepl.print-method/multifn-name]" + + "#function[clojure.core/+]" + * "#function[clojure.core/*]" + / "#function[clojure.core//]" + fn? "#function[clojure.core/fn?]")) + +(deftest print-multimethods + (require 'cider.nrepl.middleware.track-state) + (doseq [it '(print-method cider.nrepl.middleware.track-state/ns-as-map)] + (let [var (resolve it)] + (is (re-find (Pattern/compile (format "#multifn\\[%s 0x[a-z0-9]+\\]" + (:name (meta var)))) + (pr-str @var))))))