CLJS-1786: Add knob for controlling printing of namespaced maps

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))

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

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 "<cljs repl>"
-                         (with-meta
-                           `(~'ns ~'cljs.user
-                              (:require ~@repl-requires))
-                           {:line 1 :column 1})
-                         identity opts))
+             init (do
+                    (evaluate-form repl-env env "<cljs repl>"
+                      `(~'set! ~'cljs.core/*print-namespace-maps* true)
+                      identity opts)
+                    (or init
+                        #(evaluate-form repl-env env "<cljs repl>"
+                           (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*)

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)]]

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
 ;;----------------------------------------------------------------------------