diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 3a0ba681c1..abfdb908cf 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -107,6 +107,14 @@ Defaults to false."} *print-dup* false) +(def + ^{:dynamic true + :doc "*print-namespace-maps* controls whether the printer will print + namespace map literal syntax. + + Defaults to false, but the REPL binds it to true."} + *print-namespace-maps* false) + (def ^{:dynamic true :doc "*print-length* controls how many items of each collection the @@ -9411,16 +9419,44 @@ reduces them without incurring seq initialization" (when *print-newline* (newline (pr-opts)))) -(defn print-map [m print-one writer opts] +(defn- strip-ns + [named] + (if (symbol? named) + (symbol nil (name named)) + (keyword nil (name named)))) + +(defn- lift-ns + "Returns [lifted-ns lifted-map] or nil if m can't be lifted." + [m] + (when *print-namespace-maps* + (loop [ns nil + [[k v :as entry] & entries] (seq m) + lm (empty m)] + (if entry + (when (or (keyword? k) (symbol? k)) + (if ns + (when (= ns (namespace k)) + (recur ns entries (assoc lm (strip-ns k) v))) + (when-let [new-ns (namespace k)] + (recur new-ns entries (assoc lm (strip-ns k) v))))) + [ns lm])))) + +(defn print-prefix-map [prefix m print-one writer opts] (pr-sequential-writer writer (fn [e w opts] (do (print-one (key e) w opts) (-write w \space) (print-one (val e) w opts))) - "{" ", " "}" + (str prefix "{") ", " "}" opts (seq m))) +(defn print-map [m print-one writer opts] + (let [[ns lift-map] (lift-ns m)] + (if ns + (print-prefix-map (str "#:" ns) lift-map print-one writer opts) + (print-prefix-map nil m print-one writer opts)))) + (extend-protocol IPrintWithWriter LazySeq (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) diff --git a/src/main/cljs/cljs/pprint.cljs b/src/main/cljs/cljs/pprint.cljs index 208d3ced6b..13d63b916f 100644 --- a/src/main/cljs/cljs/pprint.cljs +++ b/src/main/cljs/cljs/pprint.cljs @@ -611,7 +611,7 @@ beginning of aseq" ;; Variables that control the pretty printer ;;====================================================================== -;; *print-length*, *print-level* and *print-dup* are defined in cljs.core +;; *print-length*, *print-level*, *print-namespace-maps* and *print-dup* are defined in cljs.core (def ^:dynamic ^{:doc "Bind to true if you want write to use pretty printing"} *print-pretty* true) @@ -2837,21 +2837,25 @@ column number or pretty printing" ;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>")) (defn- pprint-map [amap] - (pprint-logical-block :prefix "{" :suffix "}" - (print-length-loop [aseq (seq amap)] - (when aseq - ;;compiler gets confused with nested macro if it isn't namespaced - ;;it tries to use clojure.pprint/pprint-logical-block for some reason - (m/pprint-logical-block - (write-out (ffirst aseq)) - (-write *out* " ") - (pprint-newline :linear) - (set! *current-length* 0) ;always print both parts of the [k v] pair - (write-out (fnext (first aseq)))) - (when (next aseq) - (-write *out* ", ") - (pprint-newline :linear) - (recur (next aseq))))))) + (let [[ns lift-map] (when (not (record? amap)) + (#'cljs.core/lift-ns amap)) + amap (or lift-map amap) + prefix (if ns (str "#:" ns "{") "{")] + (pprint-logical-block :prefix prefix :suffix "}" + (print-length-loop [aseq (seq amap)] + (when aseq + ;;compiler gets confused with nested macro if it isn't namespaced + ;;it tries to use clojure.pprint/pprint-logical-block for some reason + (m/pprint-logical-block + (write-out (ffirst aseq)) + (-write *out* " ") + (pprint-newline :linear) + (set! *current-length* 0) ;always print both parts of the [k v] pair + (write-out (fnext (first aseq)))) + (when (next aseq) + (-write *out* ", ") + (pprint-newline :linear) + (recur (next aseq)))))))) (defn- pprint-simple-default [obj] ;;TODO: Update to handle arrays (?) and suppressing namespaces diff --git a/src/main/clojure/cljs/repl.cljc b/src/main/clojure/cljs/repl.cljc index d1f67dfbd2..a0036bac10 100644 --- a/src/main/clojure/cljs/repl.cljc +++ b/src/main/clojure/cljs/repl.cljc @@ -822,13 +822,17 @@ (swap! env/*compiler* assoc :js-dependency-index (deps/js-dependency-index opts)) opts) opts) - init (or init - #(evaluate-form repl-env env "" - (with-meta - `(~'ns ~'cljs.user - (:require ~@repl-requires)) - {:line 1 :column 1}) - identity opts)) + init (do + (evaluate-form repl-env env "" + `(~'set! ~'cljs.core/*print-namespace-maps* true) + identity opts) + (or init + #(evaluate-form repl-env env "" + (with-meta + `(~'ns ~'cljs.user + (:require ~@repl-requires)) + {:line 1 :column 1}) + identity opts))) read-eval-print (fn [] (let [input (binding [*ns* (create-ns ana/*cljs-ns*) diff --git a/src/test/cljs/cljs/core_test.cljs b/src/test/cljs/cljs/core_test.cljs index 86b2d99512..30c336e186 100644 --- a/src/test/cljs/cljs/core_test.cljs +++ b/src/test/cljs/cljs/core_test.cljs @@ -759,6 +759,11 @@ (is (= (with-out-str (doseq [fn (cljs-739 [] [:a :b :c :d])] (fn))) ":a\n:b\n:c\n:d\n"))))) +(deftest print-ns-maps + (testing "Testing CLJS-1786, *print-namespace-maps*" + (is (= "#:user{:a 1}" (binding [*print-namespace-maps* true] (pr-str {:user/a 1})))) + (is (= "{:user/a 1}" (binding [*print-namespace-maps* false] (pr-str {:user/a 1})))))) + (deftest test-728 (testing "Testing CLJS-728, lookup with default" (doseq [n [nil "-1" "" "0" "1" false true (js-obj)]] diff --git a/src/test/cljs/cljs/pprint_test.cljs b/src/test/cljs/cljs/pprint_test.cljs index e0b2ae6fb8..7a9b926f80 100644 --- a/src/test/cljs/cljs/pprint_test.cljs +++ b/src/test/cljs/cljs/pprint_test.cljs @@ -231,6 +231,13 @@ Usage: *hello* "#{123\n 456\n 789}\n" ) +(simple-tests print-namespace-maps-tests + (binding [*print-namespace-maps* true] (with-out-str (pprint {:user/a 1}))) + "#:user{:a 1}\n" + (binding [*print-namespace-maps* false] (with-out-str (pprint {:user/a 1}))) + "{:user/a 1}\n" + ) + ;;---------------------------------------------------------------------------- ;; clj-format tests ;;----------------------------------------------------------------------------