Improve the presentation of xref data

CHANGELOG.md

@@ -11,6 +11,7 @@
 - `cider-test`: fail-fast by default, as controlled by the new `cider-test-fail-fast` defcustom and `cider-test-toggle-fail-fast` keybinding.
 - Infer indentation specs when possible ([doc](https://docs.cider.mx/cider/indent_spec.html#indentation-inference)).
 - Add new customization variable `cider-clojurec-eval-destination` to allow specifying which REPL CLJC evals are sent to.
+- Improve the presentation of `xref` data.
 
 ### Bugs fixed
 

cider-doc.el

@@ -384,15 +384,20 @@ Tables are marked to be ignored by line wrap."
         (cider-docview-wrap-text buffer))))) ; ignores code, table blocks
 
 (defun cider--abbreviate-file-protocol (file-with-protocol)
-  "Abbreviate the file-path in `file:/path/to/file' of FILE-WITH-PROTOCOL."
-  (if (string-match "\\`file:\\(.*\\)" file-with-protocol)
-      (let ((file (match-string 1 file-with-protocol))
-            (proj-dir (clojure-project-dir)))
-        (if (and proj-dir
-                 (file-in-directory-p file proj-dir))
-            (file-relative-name file proj-dir)
-          file))
-    file-with-protocol))
+  "Abbreviate the file-path in `file:/path/to/file' of FILE-WITH-PROTOCOL.
+
+Same for `jar:file:...!/' segments."
+  (let ((result (if (string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" file-with-protocol)
+                    (match-string 3 file-with-protocol)
+                  file-with-protocol)))
+    (if (string-match "\\`file:\\(.*\\)" result)
+        (let ((file (match-string 1 result))
+              (proj-dir (clojure-project-dir)))
+          (if (and proj-dir
+                   (file-in-directory-p file proj-dir))
+              (file-relative-name file proj-dir)
+            file))
+      result)))
 
 (defun cider-docview-render-info (buffer info)
   "Emit into BUFFER formatted INFO for the Clojure or Java symbol."

cider-find.el

@@ -28,6 +28,7 @@
 
 (require 'cider-client)
 (require 'cider-common)
+(require 'cider-doc)
 (require 'cider-resolve)
 
 (require 'thingatpt)
@@ -241,12 +242,35 @@ thing at point."
   "Return the relevant identifier at point."
   (cider-symbol-at-point 'look-back))
 
+(defun cider--xref-extract-file (dict)
+  "Extracts the best possible file path from DICT."
+  (or (nrepl-dict-get dict "file-url") ;; This is the primary choice, it has a protocol and indicates an absolute path
+      ;; fall back in case it was absent or we're running an older cider-nrepl:
+      (nrepl-dict-get dict "file")))
+
+(defun cider--xref-extract-friendly-file-name (dict)
+  "Extracts the best possible friendly file name from DICT.
+These are used for presentation purposes."
+  (let* ((s (or (nrepl-dict-get dict "file") ;; these are shorter and relative, which look better in UIs.
+                (nrepl-dict-get dict "file-url")))
+         (s (cider--abbreviate-file-protocol s))
+         (line (nrepl-dict-get dict "line"))
+         (column (nrepl-dict-get dict "column")))
+    (concat s
+            (when line
+              ":")
+            (when line
+              (prin1-to-string line))
+            (when (and line column)
+              ":")
+            (when column
+              (prin1-to-string column)))))
+
 (defun cider--var-to-xref-location (var)
   "Get location of definition of VAR."
   (when-let* ((info (cider-var-info var))
               (line (nrepl-dict-get info "line"))
-              (file (or (nrepl-dict-get info "file-url")
-                        (nrepl-dict-get info "file")))
+              (file (cider--xref-extract-file info))
               (buf (cider--find-buffer-for-file file)))
     (xref-make-buffer-location
      buf

cider-xref.el

@@ -66,22 +66,22 @@ the symbol found by the xref search as argument."
                                    'action #'cider-xref-doc
                                    'help-echo "Display doc")
       (insert-text-button var-name 'type 'apropos-symbol))
-    (insert "\n  ")
-    (insert-text-button "Function" 'type 'apropos-function)
-    (insert ": ")
-    (let ((beg (point)))
-      (insert (nrepl-dict-get result "doc"))
-      (fill-region beg (point)))
+    (when-let ((doc (nrepl-dict-get result "doc")))
+      (when (not (string-equal "(not documented)" doc))
+        (insert "\n  ")
+        (let ((beg (point)))
+          (insert (propertize doc 'font-lock-face 'font-lock-doc-face))
+          (fill-region beg (point)))))
     (insert "\n")
-    (if-let* ((file-url (nrepl-dict-get result "file-url"))
-              (friendly-file (or (nrepl-dict-get result "file")
-                                 file-url))
+    (if-let* ((file-url (cider--xref-extract-file result))
+              (friendly-file (cider--xref-extract-friendly-file-name result))
               (line (nrepl-dict-get result "line")))
         (progn
-          (insert (propertize var-name
+          (insert "  "
+                  (propertize var-name
                               'font-lock-face 'font-lock-function-name-face)
                   " is defined in ")
-          (insert-text-button (cider--abbreviate-file-protocol friendly-file)
+          (insert-text-button friendly-file
                               'follow-link t
                               'action (lambda (_x)
                                         (cider-xref-source file-url line var-name)))

test/cider-doc-tests.el

@@ -0,0 +1,40 @@
+;;; cider-doc-tests.el  -*- lexical-binding: t; -*-
+
+;; Copyright © 2023 Bozhidar Batsov
+
+;; Author: Bozhidar Batsov <bozhidar@batsov.dev>
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;; This file is part of CIDER
+
+;;; Code:
+
+(require 'buttercup)
+(require 'cider-doc)
+
+(describe "cider--abbreviate-file-protocol"
+  (expect (cider--abbreviate-file-protocol "file:foo.clj")
+          :to-equal
+          "foo.clj")
+  (expect (cider--abbreviate-file-protocol "jar:file:/root/.m2/org/clojure/clojure/1.10.3/clojure-1.10.3.jar!/clojure/core.clj")
+          :to-equal
+          "clojure/core.clj")
+  (expect (cider--abbreviate-file-protocol "zip:file:/root/.m2/org/clojure/clojure/1.10.3/clojure-1.10.3.jar!/clojure/core.clj")
+          :to-equal
+          "clojure/core.clj"))