[inspect] Add support for printing compact qualified keywords

CHANGELOG.md

@@ -4,6 +4,7 @@
 
 - [#353](https://github.com/clojure-emacs/orchard/pull/353): Stacktrace: flag Clojure functions as duplicate.
 - [#355](https://github.com/clojure-emacs/orchard/pull/355): Java: resolve source files for non-base JDK classes.
+- [#354](https://github.com/clojure-emacs/orchard/pull/354): Inspector: add support for printing compact qualified keywords.
 
 ## 0.36.0 (2025-06-29)
 

src/orchard/inspect.clj

@@ -49,7 +49,8 @@
    :analytics-size-cutoff  100000
    :sort-maps false
    :only-diff false
-   :pretty-print false})
+   :pretty-print false
+   :pov-ns nil})
 
 (defn- reset-render-state [inspector]
   (-> inspector
@@ -1134,11 +1135,12 @@
 
 (defn inspect-render
   ([{:keys [max-atom-length max-value-length max-coll-size max-nested-depth value
-            pretty-print only-diff]
+            pretty-print only-diff pov-ns]
      :as inspector}]
    (binding [print/*max-atom-length*  max-atom-length
              print/*max-total-length* max-value-length
              print/*coll-show-only-diff* (boolean only-diff)
+             print/*pov-ns*           (some-> pov-ns find-ns)
              *print-length*           max-coll-size
              *print-level*            (cond-> max-nested-depth
                                         ;; In pretty mode a higher *print-level*

src/orchard/print.clj

@@ -8,6 +8,7 @@
   {:author "Oleksandr Yakushev"
    :added "0.24"}
   (:refer-clojure :exclude [print print-str])
+  (:require [clojure.string :as str])
   (:import
    (clojure.core Eduction)
    (clojure.lang AFunction Compiler IDeref IPending IPersistentMap MultiFn
@@ -16,8 +17,7 @@
    (java.io Writer)
    (java.util List Map Map$Entry)
    (mx.cider.orchard TruncatingStringWriter
-                     TruncatingStringWriter$TotalLimitExceeded))
-  (:require [clojure.string :as str]))
+                     TruncatingStringWriter$TotalLimitExceeded)))
 
 (defmulti print
   (fn [x _]
@@ -28,8 +28,8 @@
       (instance? String x)            :string
       (instance? Double x)            :double
       (instance? Number x)            :scalar
-      (instance? Keyword x)           :scalar
       (instance? Symbol x)            :scalar
+      (instance? Keyword x)           :keyword
       (instance? IRecord x)           :record
       (instance? Map x)               :map
       (instance? IPersistentVector x) :vector
@@ -52,6 +52,13 @@
   "When displaying collection diffs, whether to hide matching values."
   false)
 
+(def ^:dynamic *pov-ns*
+  "The \"point-of-view namespace\" for the printer. When bound to a namespace
+  object, use this namespace data to shorten qualified keywords:
+  - print `::foo` instead of `:pov.ns/foo`
+  - print `::alias/foo` instead of `:ns.aliases.in.pov.ns/foo`"
+  nil)
+
 (defn- print-coll-item
   "Print an item in the context of a collection. When printing a map, don't print
   `[]` characters around map entries."
@@ -114,6 +121,22 @@
 (defmethod print :scalar [^Object x, ^Writer w]
   (.write w (.toString x)))
 
+(defmethod print :keyword [^Keyword kw, ^Writer w]
+  (if-some [kw-ns (and *pov-ns* (namespace kw))]
+    (if (= kw-ns (name (ns-name *pov-ns*)))
+      (do (.write w "::")
+          (.write w (name kw)))
+      (if-some [matched-alias (some (fn [[alias ns]]
+                                      (when (= kw-ns (name (ns-name ns)))
+                                        alias))
+                                    (ns-aliases *pov-ns*))]
+        (do (.write w "::")
+            (.write w (name matched-alias))
+            (.write w "/")
+            (.write w (name kw)))
+        (.write w (.toString kw))))
+    (.write w (.toString kw))))
+
 (defmethod print :double [x, ^Writer w]
   (cond (= Double/POSITIVE_INFINITY x) (.write w "##Inf")
         (= Double/NEGATIVE_INFINITY x) (.write w "##-Inf")

test/orchard/inspect_test.clj

@@ -1777,6 +1777,18 @@
              render
              contents-section))))
 
+(deftest compact-keywords-test
+  (testing "when :pov-ns is passed, use it to compact qualified keywords"
+    (is+ ["--- Contents:" [:newline]
+          "  " [:value "::foo" pos?] " = " [:value "1" pos?] [:newline]
+          "  " [:value "::str/bar" pos?] " = " [:value "2" pos?] [:newline]
+          "  " [:value "::walk/baz" pos?] " = " [:value "3" pos?]]
+         (-> {::foo 1
+              ::str/bar 2
+              :clojure.walk/baz 3}
+             (inspect {:pov-ns 'orchard.inspect-test})
+             render contents-section))))
+
 (deftest tap-test
   (testing "tap-current-value"
     (let [proof (atom [])

test/orchard/print_test.clj

@@ -156,3 +156,29 @@
 (deftest print-custom-print-method
   (is (= "hello"
          (sut/print-str (with-meta (->TestRecord 1 2 3 4) {:type ::custom-rec})))))
+
+(deftest qualified-keywords-compaction
+  (are [kw repr] (= repr (sut/print-str kw))
+    :foo     ":foo"
+    :foo/bar ":foo/bar"
+    ::foo    ":orchard.print-test/foo"
+    ::t/foo  ":clojure.test/foo")
+  (is (= ":foo" (sut/print-str :foo)))
+  (is (= ":foo/bar" (sut/print-str :foo/bar)))
+  (is (= ":orchard.print-test/foo" (sut/print-str ::foo)))
+  (is (= ":clojure.test/foo" (sut/print-str :clojure.test/foo)))
+
+  (testing "binding *pov-ns* enables keyword compaction"
+    (binding [sut/*pov-ns* (find-ns 'orchard.print-test)]
+      (are [kw repr] (= repr (sut/print-str kw))
+        :foo             ":foo"
+        :foo/bar         ":foo/bar"
+        ::foo            "::foo"
+        ::t/foo          "::t/foo"
+        :clojure.set/foo ":clojure.set/foo")))
+
+  (testing "from other pov NS the printing will be different"
+    (binding [sut/*pov-ns* (create-ns 'throwaway)]
+      (are [kw repr] (= repr (sut/print-str kw))
+        ::foo    ":orchard.print-test/foo"
+        ::t/foo          ":clojure.test/foo"))))