Implement dynamic font-locking

Ditch instrumented defs overlay for the new font-locking.
All macros are now font-locked.
This is configurable via the cider-font-lock-dynamically variable.

CHANGELOG.md

@@ -4,6 +4,7 @@
 
 ### New features
 
+* [#1301](https://github.com/clojure-emacs/cider/issues/1301): CIDER can do dynamic font-locking of defined variables, functions, and macros. This is controlled by the `cider-font-lock-dynamically` custom option.
 * [#1271](https://github.com/clojure-emacs/cider/issues/1271): New possible value (`always-save`) for `cider-prompt-save-file-on-load`.
 * [#1197](https://github.com/clojure-emacs/cider/issues/1197): Display some indication that we're waiting for a result for long-running evaluations.
 * [#1127](https://github.com/clojure-emacs/cider/issues/1127): Make it possible to associate a buffer with a connection (via `cider-assoc-buffer-with-connection`).

README.md

@@ -466,6 +466,15 @@ font-locked as in `clojure-mode` use the following:
 (setq cider-repl-use-clojure-font-lock t)
 ```
 
+* CIDER can syntax highlight symbols that are known to be defined. By default,
+  this is done on symbols from the `clojure.core` namespace as well as macros
+  from any namespace. If you'd like CIDER to also colorize usages of functions
+  and variables from any namespace, do:
+
+```el
+(setq cider-font-lock-dynamically '(macro core function var))
+```
+
 * You can control the <kbd>C-c C-z</kbd> key behavior of switching to the REPL buffer
 with the `cider-switch-to-repl-command` variable.  While the default command
 `cider-switch-to-relevant-repl-buffer` should be an adequate choice for

cider-debug.el

@@ -104,28 +104,6 @@ This variable must be set before starting the repl connection."
 
 
 ;;; Implementation
-(defun cider--update-instrumented-defs (defs)
-  "Update which DEFS in current buffer are instrumented."
-  (remove-overlays nil nil 'cider-type 'instrumented-defs)
-  (save-excursion
-    (dolist (name defs)
-      (goto-char (point-min))
-      (when (search-forward-regexp
-             (format "(def.*\\s-\\(%s\\)" (regexp-quote name))
-             nil 'noerror)
-        (cider--make-overlay
-         (match-beginning 1) (match-end 1) 'instrumented-defs
-         'face 'cider-instrumented-face)))))
-
-(defun cider--debug-handle-instrumented-defs (defs ns)
-  "Update display of NS according to instrumented DEFS."
-  (-when-let (buf (-first (lambda (b) (with-current-buffer b
-                                   (and (derived-mode-p 'clojure-mode)
-                                        (string= ns (cider-current-ns)))))
-                          (buffer-list)))
-    (with-current-buffer buf
-      (cider--update-instrumented-defs defs))))
-
 (defun cider-browse-instrumented-defs ()
   "List all instrumented definitions."
   (interactive)
@@ -147,8 +125,6 @@ This variable must be set before starting the repl connection."
 (defun cider--debug-response-handler (response)
   "Handle responses from the cider.debug middleware."
   (nrepl-dbind-response response (status id instrumented-defs ns causes)
-    (when (member "instrumented-defs" status)
-      (cider--debug-handle-instrumented-defs instrumented-defs ns))
     (when (member "eval-error" status)
       (cider--render-stacktrace-causes causes))
     (when (member "need-debug-input" status)

cider-mode.el

@@ -33,6 +33,7 @@
 (require 'cider-interaction)
 (require 'cider-eldoc)
 (require 'cider-repl)
+(require 'cider-resolve)
 
 (defcustom cider-mode-line-show-connection t
   "If the mode-line lighter should detail the connection."
@@ -178,6 +179,97 @@ entirely."
         ["Version info" cider-version]))
     map))
 
+;;; Dynamic font locking
+(defcustom cider-font-lock-dynamically '(macro core)
+  "Specifies how much dynamic font-locking CIDER should use.
+Dynamic font-locking this refers to applying syntax highlighting to vars
+defined in the currently active nREPL connection. This is done in addition
+to `clojure-mode's usual (static) font-lock, so even if you set this
+variable to nil you'll still see basic syntax highlighting.
+
+The value is a list of symbols, each one indicates a different type of var
+that should be font-locked:
+   `macro' (default): Any defined macro gets the `font-lock-builtin-face'.
+   `function': Any defined function gets the `font-lock-function-face'.
+   `var': Any non-local var gets the `font-lock-variable-face'.
+   `core' (default): Any symbol from clojure.core (face depends on type).
+
+The value can also be t, which means to font-lock as much as possible."
+  :type '(choice (set :tag "Fine-tune font-locking"
+                      (const :tag "Any defined macro" macro)
+                      (const :tag "Any defined function" function)
+                      (const :tag "Any defined var" var)
+                      (const :tag "Any symbol from clojure.core" core))
+                 (const :tag "Font-lock as much as possible" t))
+  :group 'cider
+  :package-version '(cider . "0.10.0"))
+
+(defvar cider-font-lock-keywords clojure-font-lock-keywords)
+
+(defun cider--compile-font-lock-keywords (symbols-dict core-dict)
+  "Return a list of font-lock rules for the symbols in SYMBOLS-DICT."
+  (let ((cider-font-lock-dynamically (if (eq cider-font-lock-dynamically t)
+                                     '(function var macro core)
+                                   cider-font-lock-dynamically))
+        macros functions vars instrumented)
+    (when (memq 'core cider-font-lock-dynamically)
+      (nrepl-dict-map (lambda (sym meta)
+                        (when (nrepl-dict-get meta "cider-instrumented")
+                          (push sym instrumented))
+                        (cond
+                         ((nrepl-dict-get meta "macro")
+                          (push sym macros))
+                         ((nrepl-dict-get meta "arglists")
+                          (push sym functions))
+                         (t
+                          (push sym vars))))
+                      core-dict))
+    (nrepl-dict-map (lambda (sym meta)
+                      (when (nrepl-dict-get meta "cider-instrumented")
+                        (push sym instrumented))
+                      (cond
+                       ((and (memq 'macro cider-font-lock-dynamically)
+                             (nrepl-dict-get meta "macro"))
+                        (push sym macros))
+                       ((and (memq 'function cider-font-lock-dynamically)
+                             (nrepl-dict-get meta "arglists"))
+                        (push sym functions))
+                       ((memq 'var cider-font-lock-dynamically)
+                        (push sym vars))))
+                    symbols-dict)
+    `(;; Aliases
+      ("\\_<\\(?1:\\(\\s_\\|\\sw\\)+\\)/" 1 font-lock-type-face)
+
+      ,@(when macros
+          `((,(concat (rx (or "(" "#'")) ; Can't take the value of macros.
+                      "\\(" (regexp-opt macros 'symbols) "\\)")
+             1 font-lock-keyword-face append)))
+      ,@(when functions
+          `((,(regexp-opt functions 'symbols) 0 font-lock-function-name-face append)))
+      ,@(when vars
+          `((,(regexp-opt vars 'symbols) 0 font-lock-variable-name-face append)))
+      ,@(when instrumented
+          `((,(regexp-opt instrumented 'symbols) 0 'cider-instrumented-face prepend))))))
+
+(defconst cider-static-font-lock-keywords
+  (eval-when-compile
+    `((,(regexp-opt '("#break" "#dbg") 'symbols) 0 font-lock-warning-face)))
+  "Default expressions to highlight in CIDER mode.")
+
+(defun cider-refresh-font-lock (&optional ns)
+  "Ensure that the current buffer has up-to-date font-lock rules.
+NS defaults to `cider-current-ns', and it can also be a dict describing the
+namespace itself."
+  (interactive)
+  (when cider-font-lock-dynamically
+    (-when-let (symbols (cider-resolve-ns-symbols (or ns (cider-current-ns))))
+      (setq-local cider-font-lock-keywords
+                  (append clojure-font-lock-keywords
+                          cider-static-font-lock-keywords
+                          (cider--compile-font-lock-keywords
+                           symbols (cider-resolve-ns-symbols (cider-resolve-core-ns))))))
+    (font-lock-refresh-defaults)))
+
 ;;;###autoload
 (define-minor-mode cider-mode
   "Minor mode for REPL interaction from a Clojure buffer.
@@ -190,6 +282,10 @@ entirely."
   (make-local-variable 'completion-at-point-functions)
   (add-to-list 'completion-at-point-functions
                #'cider-complete-at-point)
+  (when (consp font-lock-defaults)
+    (setq-local font-lock-defaults
+                (cons 'cider-font-lock-keywords (cdr font-lock-defaults))))
+  (cider-refresh-font-lock)
   (setq next-error-function #'cider-jump-to-compilation-error))
 
 (provide 'cider-mode)

cider-repl.el

@@ -169,15 +169,24 @@ PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'."
                "0.10.0")
 
 (defvar-local cider-repl-ns-cache nil
-  "A dict holding information about all currently loaded namespaces.")
+  "A dict holding information about all currently loaded namespaces.
+This cache is stored in the connection buffer.  Other buffer's access it
+via `cider-current-connection'.")
 
 (defun cider-repl--state-handler (response)
   "Handle the server STATE.
 Currently, this is only used to keep `cider-repl-type' updated."
-  (-when-let (state (nrepl-dict-get response "state"))
-    (nrepl-dbind-response state (repl-type changed-namespaces)
-      (setq cider-repl-type repl-type)
-      (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces)))))
+  (with-demoted-errors "Error in `cider-repl--state-handler': %s"
+    (-when-let (state (nrepl-dict-get response "state"))
+      (nrepl-dbind-response state (repl-type changed-namespaces)
+        (setq cider-repl-type repl-type)
+        (unless (nrepl-dict-empty-p changed-namespaces)
+          (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces))
+          (dolist (b (buffer-list))
+            (with-current-buffer b
+              (when cider-mode
+                (-when-let (ns-dict (nrepl-dict-get changed-namespaces (cider-current-ns)))
+                  (cider-refresh-font-lock ns-dict))))))))))
 
 (defun cider-repl-create (endpoint)
   "Create a REPL buffer and install `cider-repl-mode'.

cider-resolve.el

@@ -19,34 +19,77 @@
 
 ;;; Commentary:
 
+;; The ns cache is a dict of namespaces stored in the connection buffer. This
+;; file offers functions to easily get information about variables from this
+;; cache, given the variable's name and the file's namespace.  This
+;; functionality is similar to that offered by the `cider-var-info' function
+;; (and others). The difference is that all functions in this file operate
+;; without contacting the server (they still rely on an active connection
+;; buffer, but no messages are actually exchanged).
+
+;; For this reason, the functions here are well suited for very
+;; performance-sentitive operations, such as font-locking or
+;; indentation. Meanwhile, operations like code-jumping are better off
+;; communicating with the middleware, just in the off chance that the cache is
+;; outdated.
+
+;; Below is a typical entry on this cache dict. Note that clojure.core symbols
+;; are excluded from the refers to save space.
+
+;; "cider.nrepl.middleware.track-state"
+;; (dict "aliases"
+;;       (dict "cljs" "cider.nrepl.middleware.util.cljs"
+;;             "misc" "cider.nrepl.middleware.util.misc"
+;;             "set" "clojure.set")
+;;       "interns" (dict a
+;;                       "assoc-state"    (dict "arglists"
+;;                                              (("response"
+;;                                                (dict "as" "msg" "keys"
+;;                                                      ("session")))))
+;;                       "filter-core"    (dict "arglists"
+;;                                              (("refers")))
+;;                       "make-transport" (dict "arglists"
+;;                                              (((dict "as" "msg" "keys"
+;;                                                      ("transport")))))
+;;                       "ns-as-map"      (dict "arglists"
+;;                                              (("ns")))
+;;                       "ns-cache"       (dict)
+;;                       "relevant-meta"  (dict "arglists"
+;;                                              (("var")))
+;;                       "update-vals"    (dict "arglists"
+;;                                              (("m" "f")))
+;;                       "wrap-tracker"   (dict "arglists"
+;;                                              (("handler"))))
+;;       "refers" (dict "set-descriptor!" "#'clojure.tools.nrepl.middleware/set-descriptor!"))
+
 ;;; Code:
 
 (require 'nrepl-client)
 (require 'cider-interaction)
-(require 'cider-repl)
+
+(defvar cider-repl-ns-cache)
 
 (defun cider-resolve--get-in (&rest keys)
-  "Return (nrepl-dict-get-in cider-repl-ns-cache keys)."
+  "Return (nrepl-dict-get-in cider-repl-ns-cache KEYS)."
   (when cider-connections
-    (nrepl-dict-get-in
-     (with-current-buffer (cider-current-connection)
-       cider-repl-ns-cache)
-     keys)))
+    (with-current-buffer (cider-current-connection)
+      (nrepl-dict-get-in cider-repl-ns-cache keys))))
 
 (defun cider-resolve-alias (ns alias)
   "Return the namespace that ALIAS refers to in namespace NS.
 If it doesn't point anywhere, returns ALIAS."
   (or (cider-resolve--get-in ns "aliases" alias)
       alias))
 
+(defconst cider-resolve--prefix-regexp "\\`\\(?:#'\\)?\\([^/]+\\)/")
+
 (defun cider-resolve-var (ns var)
   "Return a dict of the metadata of a clojure var VAR in namespace NS.
 VAR is a string.
 Return nil only if VAR cannot be resolved."
-  (let* ((prefix-regexp "\\`\\([^/]+\\)/")
-         (var-ns (when (string-match prefix-regexp var)
+  (let* ((var-ns (when (string-match cider-resolve--prefix-regexp var)
                    (cider-resolve-alias ns (match-string 1 var))))
-         (name (replace-regexp-in-string prefix-regexp "" var)))
+         (name (replace-regexp-in-string cider-resolve--prefix-regexp "" var)))
     (or
      (cider-resolve--get-in (or var-ns ns) "interns" name)
      (unless var-ns
@@ -57,16 +100,31 @@ Return nil only if VAR cannot be resolved."
          (unless (equal ns "clojure.core")
            (cider-resolve-var "clojure.core" name)))))))
 
-(defun cider-match-instrumented-symbol (n face)
-  "Return a face specification for font-locking.
-If (match-string N) is an instrumented symbol, return 
-    (face cider-instrumented-face FACE)
-otherwise, return (face FACE)."
-  (cons 'face
-        (if (nrepl-dict-get (cider-resolve-var (cider-current-ns) (match-string n))
-                            "cider-instrumented")
-            `((cider-instrumented-face ,face))
-          (list face))))
+(defun cider-resolve-core-ns ()
+  "Return a dict of the core namespace for current connection.
+This will be clojure.core or cljs.core depending on `cider-repl-type'."
+  (when (cider-connected-p)
+    (with-current-buffer (cider-current-connection)
+      (cider-resolve--get-in (if (equal cider-repl-type "cljs")
+                    "cljs.core"
+                  "clojure.core")))))
+
+(defun cider-resolve-ns-symbols (ns)
+  "Return a dict of all valid symbols in NS.
+Each entry's value is the metadata of the var that the symbol refers to.
+NS can be the namespace name, or a dict of the namespace itself."
+  (-when-let (dict (if (stringp ns)
+                       (cider-resolve--get-in ns)
+                     ns))
+    (nrepl-dbind-response dict (interns refers aliases)
+      (append interns
+              (nrepl-dict-flat-map (lambda (sym var) (list sym (cider-resolve-var ns var)))
+                                   refers)
+              (nrepl-dict-flat-map (lambda (alias namespace)
+                                     (nrepl-dict-flat-map (lambda (sym meta)
+                                                            (list (concat alias "/" sym) meta))
+                                                          (cider-resolve--get-in namespace "interns")))
+                                   aliases)))))
 
 (provide 'cider-resolve)
 ;;; cider-resolve.el ends here

nrepl-client.el

@@ -348,6 +348,13 @@ any of the values is nil."
       (setq out (nrepl-dict-get out (pop keys))))
     out))
 
+(defun nrepl-dict-flat-map (function dict)
+  "Map FUNCTION over DICT and flatten the result.
+FUNCTION follows the same restrictions as in `nrepl-dict-map', and it must
+also alway return a sequence (since the result will be flattened)."
+  (when dict
+    (apply #'append (nrepl-dict-map function dict))))
+
 (defun nrepl--cons (car list-or-dict)
   "Generic cons of CAR to LIST-OR-DICT."
   (if (eq (car list-or-dict) 'dict)