diff --git a/CHANGELOG.md b/CHANGELOG.md
index bcbaeaf7b..a250d55aa 100644
--- a/CHANGELOG.md
+++ b/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`).
diff --git a/README.md b/README.md
index e8ad2ab48..2a65e69b5 100644
--- a/README.md
+++ b/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 C-c C-z 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
diff --git a/cider-debug.el b/cider-debug.el
index bbbe40f53..eaef3b769 100644
--- a/cider-debug.el
+++ b/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)
diff --git a/cider-mode.el b/cider-mode.el
index a084dbf12..00912d57e 100644
--- a/cider-mode.el
+++ b/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)
diff --git a/cider-repl.el b/cider-repl.el
index 0759eb2ec..315e062cb 100644
--- a/cider-repl.el
+++ b/cider-repl.el
@@ -168,12 +168,25 @@ PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'."
"use `nrepl-make-buffer-name' with `nrepl-repl-buffer-name-template' instead."
"0.10.0")
+(defvar-local cider-repl-ns-cache nil
+ "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)
- (setq cider-repl-type repl-type))))
+ (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'.
diff --git a/cider-resolve.el b/cider-resolve.el
new file mode 100644
index 000000000..fdcb67d58
--- /dev/null
+++ b/cider-resolve.el
@@ -0,0 +1,130 @@
+;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection
+
+;; Copyright © 2015 Artur Malabarba
+
+;; Author: Artur Malabarba
+
+;; 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 .
+
+;;; 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)
+
+(defvar cider-repl-ns-cache)
+
+(defun cider-resolve--get-in (&rest keys)
+ "Return (nrepl-dict-get-in cider-repl-ns-cache KEYS)."
+ (when cider-connections
+ (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* ((var-ns (when (string-match cider-resolve--prefix-regexp var)
+ (cider-resolve-alias ns (match-string 1 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
+ ;; If the var had no prefix, it might be referred.
+ (-if-let (referal (cider-resolve--get-in ns "refers" name))
+ (cider-resolve-var ns referal)
+ ;; Or it might be from core.
+ (unless (equal ns "clojure.core")
+ (cider-resolve-var "clojure.core" name)))))))
+
+(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
diff --git a/nrepl-client.el b/nrepl-client.el
index 2c504e293..053b19392 100644
--- a/nrepl-client.el
+++ b/nrepl-client.el
@@ -330,6 +330,31 @@ FN must accept two arguments key and value."
collect (funcall fn (car l) (cadr l)))
(error "Not a nREPL dict")))
+(defun nrepl-dict-merge (dict1 dict2)
+ "Destructively merge DICT2 into DICT1.
+Keys in DICT2 override those in DICT1."
+ (let ((base (or dict1 '(dict))))
+ (nrepl-dict-map (lambda (k v)
+ (nrepl-dict-put base k v))
+ (or dict2 '(dict)))
+ base))
+
+(defun nrepl-dict-get-in (dict keys)
+ "Return the value in a nested DICT.
+KEYS is a list of keys. Return nil if any of the keys is not present or if
+any of the values is nil."
+ (let ((out dict))
+ (while (and keys out)
+ (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)
diff --git a/test/nrepl-dict-tests.el b/test/nrepl-dict-tests.el
new file mode 100644
index 000000000..07b65944e
--- /dev/null
+++ b/test/nrepl-dict-tests.el
@@ -0,0 +1,11 @@
+(require 'nrepl-client)
+
+(ert-deftest dict-merge ()
+ (let ((input '(dict 2 4 1 2 "10" "90" "a" "b")))
+ (should (equal (nrepl-dict-merge input '(dict 1 3 "10" me))
+ '(dict 2 4 1 3 "10" me "a" "b")))
+ (should (equal input '(dict 2 4 1 3 "10" me "a" "b"))))
+ (should (equal (nrepl-dict-merge nil '(dict 1 3 "10" me))
+ '(dict 1 3 "10" me)))
+ (should (equal (nrepl-dict-merge '(dict 1 3 "10" me) nil)
+ '(dict 1 3 "10" me))))